Edit Excel file ОЧ.НУЖНА HELP ?!?!?!
Есть такая проблема. Уменя есть исходный Эксель файл, ну типа шаблон. Я его открываю и записываю что либо. Потом закрываю. Но после этого в самом Экселе он становитья не видимый. я включил строки (см далее между **!!!**) которые создают видимость рабочей книги, но при этом когда прога работает в фоне (по таймеру) сам по себе открывается Эксел, а это как раз не нужно - в этом то и проблема. (Либо сам по себе открывается Эксель, либо нe видна рабочая книга.) ПОМОГИТЕ !!!
' вот чать кода, обьявление апишек не привожу.
Dim appExcel As Excel.Application
Dim wbkNew As Excel.Workbook, wksNew As Excel.Worksheet
Dim str_new_file As String
Dim ExcelWasNotRunning As Boolean
Dim str_ar_fn As String
On Error Resume Next
' определяем запущен ли Эксель
Set appExcel = GetObject(, "Excel.Application")
If Err.Number <> 0 Then ExcelWasNotRunning = True
Err.Clear ' Clear Err object in case error occurred.
On Error GoTo Error_OLEAccessToExcel
str_path = "Z:\folder1\"
str_filename_tpl = "file1.xls"
str_filename_new = "file2.xls"
DetectExcel
Set wbkNew = GetObject(str_path & str_filename_tpl, "Excel.Sheet")
Set wksNew = wbkNew.ActiveSheet
Set appExcel = wbkNew.Parent
' .. далее далаем вносим любые данные и изменениЯ
wks_New.Range("B2").Value =" Сегодня : " & Now()
'--- сохранЯем под другим именем, но ...
' ... перед сохраненим удалЯем старую версию ---
' if file exist
On Error Resume Next
Kill str_path & str_filename_new
On Error GoTo Error_OLEAccessToExcel
wbkNew.SaveAs str_path & str_filename_new
'' **!!!** если следующие строкi не включить в код то файл не видно
wbkNew.Application.WindowState = xlMinimized
wbkNew.Application.Visible = True
wbkNew.Parent.Windows(str_filename_new).Visible = True
'' **!!!**
wbkNew.Close SaveChanges:=True
If ExcelWasNotRunning = True Then
appExcel.Quit
End If
Set wksNew = Nothing
Set wbkNew = Nothing
Set appExcel = Nothing
Sub DetectExcel()
' Procedure dectects a running Excel and registers it.
Const WM_USER = 1024
Dim hWnd As Long
' If Excel is running this API call returns its handle.
hWnd = FindWindow("XLMAIN", 0)
If hWnd = 0 Then ' 0 means Excel not running.
Exit Sub
Else
' Excel is running so use the SendMessage API
' function to enter it in the Running Object Table.
SendMessage hWnd, WM_USER + 18, 0, 0
End If
End Sub
' вот чать кода, обьявление апишек не привожу.
Dim appExcel As Excel.Application
Dim wbkNew As Excel.Workbook, wksNew As Excel.Worksheet
Dim str_new_file As String
Dim ExcelWasNotRunning As Boolean
Dim str_ar_fn As String
On Error Resume Next
' определяем запущен ли Эксель
Set appExcel = GetObject(, "Excel.Application")
If Err.Number <> 0 Then ExcelWasNotRunning = True
Err.Clear ' Clear Err object in case error occurred.
On Error GoTo Error_OLEAccessToExcel
str_path = "Z:\folder1\"
str_filename_tpl = "file1.xls"
str_filename_new = "file2.xls"
DetectExcel
Set wbkNew = GetObject(str_path & str_filename_tpl, "Excel.Sheet")
Set wksNew = wbkNew.ActiveSheet
Set appExcel = wbkNew.Parent
' .. далее далаем вносим любые данные и изменениЯ
wks_New.Range("B2").Value =" Сегодня : " & Now()
'--- сохранЯем под другим именем, но ...
' ... перед сохраненим удалЯем старую версию ---
' if file exist
On Error Resume Next
Kill str_path & str_filename_new
On Error GoTo Error_OLEAccessToExcel
wbkNew.SaveAs str_path & str_filename_new
'' **!!!** если следующие строкi не включить в код то файл не видно
wbkNew.Application.WindowState = xlMinimized
wbkNew.Application.Visible = True
wbkNew.Parent.Windows(str_filename_new).Visible = True
'' **!!!**
wbkNew.Close SaveChanges:=True
If ExcelWasNotRunning = True Then
appExcel.Quit
End If
Set wksNew = Nothing
Set wbkNew = Nothing
Set appExcel = Nothing
Sub DetectExcel()
' Procedure dectects a running Excel and registers it.
Const WM_USER = 1024
Dim hWnd As Long
' If Excel is running this API call returns its handle.
hWnd = FindWindow("XLMAIN", 0)
If hWnd = 0 Then ' 0 means Excel not running.
Exit Sub
Else
' Excel is running so use the SendMessage API
' function to enter it in the Running Object Table.
SendMessage hWnd, WM_USER + 18, 0, 0
End If
End Sub