Dim XL As New Excel.Application
Dim iFileName$, iPath$, iRow&
iFileName = "C:\My Documents\Test.xls" 'укажите реально существующий файл
iPath = "C:\My Documents\" 'укажите папку для сохранения
iRow = 5
XL.Visible = True
XL.EnableEvents = False
With XL.Workbooks.Open(Filename:=iFileName, UpdateLinks:=0)
With .Worksheets(1).Cells(iRow, 3).Resize(2, 4)
.Borders(10).Weight = -4138
.Borders(11).Weight = -4138
End With
'.SaveAs Filename:=Format(Now, "YYYY M H_S"), FileFormat:=xlNormal
.Close SaveChanges:=True, Filename:=iPath & Format(Now, "YYYY M H S")
End With
'XL.EnableEvents = True
XL.Quit
Непрорисовка в бордюров Excel через VB
Делается следующие:
Первый запуск идеально очерчивает бордюры и сохраняет в новом файле.
На второй запуск сохраняет но бордюры не очерчивает.
Как исправить?
Код:
Private Sub Command9_Click()
Dim XL As New Excel.Application
XL.Workbooks.Open (file_name)
XL.Visible = True
Range(Cells(number_row, 3), Cells(number_row + 1, 3)).Borders(10).Weight = -4138
Range(Cells(number_row, 4), Cells(number_row + 1, 4)).Borders(10).Weight = -4138
Range(Cells(number_row, 5), Cells(number_row + 1, 5)).Borders(10).Weight = -4138
Range(Cells(number_row, 6), Cells(number_row + 1, 6)).Borders(10).Weight = -4138
XL.ActiveWorkbook.SaveAs (Year(Date) & " " & Month(Date) & " " & Hour(Time) & " " & Second(Time))
Set XL = Nothing
End Sub
Dim XL As New Excel.Application
XL.Workbooks.Open (file_name)
XL.Visible = True
Range(Cells(number_row, 3), Cells(number_row + 1, 3)).Borders(10).Weight = -4138
Range(Cells(number_row, 4), Cells(number_row + 1, 4)).Borders(10).Weight = -4138
Range(Cells(number_row, 5), Cells(number_row + 1, 5)).Borders(10).Weight = -4138
Range(Cells(number_row, 6), Cells(number_row + 1, 6)).Borders(10).Weight = -4138
XL.ActiveWorkbook.SaveAs (Year(Date) & " " & Month(Date) & " " & Hour(Time) & " " & Second(Time))
Set XL = Nothing
End Sub
На второй запуск сохраняет но бордюры не очерчивает.
Как исправить?
Цитата: pashulka
Код:
Dim XL As New Excel.Application
Dim iFileName$, iPath$, iRow&
iFileName = "C:\My Documents\Test.xls" 'укажите реально существующий файл
iPath = "C:\My Documents\" 'укажите папку для сохранения
iRow = 5
XL.Visible = True
XL.EnableEvents = False
With XL.Workbooks.Open(Filename:=iFileName, UpdateLinks:=0)
With .Worksheets(1).Cells(iRow, 3).Resize(2, 4)
.Borders(10).Weight = -4138
.Borders(11).Weight = -4138
End With
'.SaveAs Filename:=Format(Now, "YYYY M H_S"), FileFormat:=xlNormal
.Close SaveChanges:=True, Filename:=iPath & Format(Now, "YYYY M H S")
End With
'XL.EnableEvents = True
XL.Quit
Dim iFileName$, iPath$, iRow&
iFileName = "C:\My Documents\Test.xls" 'укажите реально существующий файл
iPath = "C:\My Documents\" 'укажите папку для сохранения
iRow = 5
XL.Visible = True
XL.EnableEvents = False
With XL.Workbooks.Open(Filename:=iFileName, UpdateLinks:=0)
With .Worksheets(1).Cells(iRow, 3).Resize(2, 4)
.Borders(10).Weight = -4138
.Borders(11).Weight = -4138
End With
'.SaveAs Filename:=Format(Now, "YYYY M H_S"), FileFormat:=xlNormal
.Close SaveChanges:=True, Filename:=iPath & Format(Now, "YYYY M H S")
End With
'XL.EnableEvents = True
XL.Quit
ничего нового не увидел... + мне необходимо выдавать новое сохраненное окно без закрытия старого
нужно четкое пояснение причины неотрисовки, а не переписывание программы.
за об'яснениями к преподу, а по поводу закрытия приложения, ну уберите из кода XL.Quit , закоммент. .Close и раскомм. .SaveAs и будет Вам счастье
Цитата: pashulka
за об'яснениями к преподу, а по поводу закрытия приложения, ну уберите из кода XL.Quit , закоммент. .Close и раскомм. .SaveAs и будет Вам счастье
К какому преподу?
Вы сами пробовали повторно рисовать бордюры? Вы можете обосновать(пояснить) свой код?
К любому преподу, который, в силу своей профессии, обязан об'яснять очевидные вещи. Я же, просто отвечаю на поставленный Вами вопрос "Как исправить?" и предлагаю не полагаться на авось (а именно этот подход реализован в исходном коде, где используется активная книга и активный лист), а явно указывать рабочую книгу и рабочий лист.
Цитата: pashulka
К любому преподу, который, в силу своей профессии, обязан об'яснять очевидные вещи. Я же, просто отвечаю на поставленный Вами вопрос "Как исправить?" и предлагаю не полагаться на авось (а именно этот подход реализован в исходном коде, где используется активная книга и активный лист), а явно указывать рабочую книгу и рабочий лист.
Ваш метод проблему не решил!
Ячейки по прежнему заполняются, файл сохраняется.
А бордюры не рисуются!!!
Программа в 1500 строк. И все рушится из за этих бордюров. Подумываю переписать все в PHP а то VB чет тупит с этими бордюрами.
Если бордюры не рисуются из-за того, что возникает ошибка, то это может означать, что ячейки + лист, где предполагается изменять параметры форматирования, защищены, если ошибки нет, то возможно, что Вы используете On Error Resume Next или они рисуются, просто не там, где Вы этого ожидаете ... попробуйте, для начала, выделить эти ячейки, использовав, например :
Код:
XL.GoTo Cells(number_row, 3), True