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 чет тупит с этими бордюрами.
Код:
XL.GoTo Cells(number_row, 3), True