Excel в стиле Ultra (часть 2)
Эта статья — продолжение темы, начатой в «Excel в стиле Ultra»
Как-то я задавал вопрос о том, что делать с невидимыми экселями, которые остаются висеть в памяти из-за ошибок. Тимур Дадаханов (timur-dadakhanov@rambler.ru) прислал свое решение этого и сразу целого вороха других проблемсов. Ему слово :-)
К сожалению, с самого начала я не заметил в вашей статье ключевую фразу «При возникновении ошибки этот невидимый эксель…». Поэтому, когда запускать эту функцию по закрытию всех невидимых экселей, я не знаю. может и не нужно вовсе. Ну, например, при выгрузки данных в шаблон Excel, ее можно применить, если предыдущая выгрузка была отменена пользователем. тогда при повторном запуске отчета, функция определит «дохлый» excel и закроет его, и новый отчет выгрузится без ошибок. В ней используется техника WinAPI. С помощью этой техники можно с навиженом, да и с любым приложением делать что угодно. Единственный минус – должен сначала загрузиться Excel, а это на первую загрузку Excel в системе требует времени.
VAR
objScript : Automation :'Microsoft Script Control 1.0'.ScriptControl";
objShell : Automation :'Windows Script Host Object Model'.WshShell";
xlApp : Automation :'Microsoft Excel 11.0 Object Library'.Application";
txtRegistryKey : Text[100];
txtRegistryType : Text[30];
txtRegistryValue : Text[1];
txtRegistryNewValue : Text[1];
BEGIN
CREATE(objScript);
CREATE(objShell);
IF NOT CREATE(xlApp) THEN
ERROR('Microsoft Excel не установлен!');
//Открываем доступ к Excel макросам
txtRegistryKey := 'HKEY_CURRENT_USER\Software\Microsoft\Office\' + xlApp.Version + '\Excel\Security\AccessVBOM';
CLEAR(xlApp);
txtRegistryType := 'REG_DWORD';
txtRegistryValue := objShell.RegRead(txtRegistryKey);
txtRegistryNewValue :='1';
objShell.RegWrite(txtRegistryKey,txtRegistryNewValue, txtRegistryType);
//Добавляем макросы в Excel
objScript.Language('VBScript');
objScript.AddCode('on error resume next');
objScript.AddCode('set Application=createobject("Excel.Application")');
objScript.AddCode('set Workbook=Application.Workbooks.Add');
objScript.AddCode('Set Module = Workbook.VBProject.VBComponents.Add(1)');
objScript.AddCode('Module.CodeModule.AddFromString ("Private Declare Function EnumWindows ' +
'Lib ""user32"" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long")');
objScript.AddCode('Module.CodeModule.AddFromString ("Private Declare Function GetClassNameA Lib ""user32"" ' +
'(ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long")');
objScript.AddCode('Module.CodeModule.AddFromString ("Private Declare Function IsWindowVisible Lib ' +
' ""user32"" (ByVal hwnd As Long) As Boolean")');
objScript.AddCode('Module.CodeModule.AddFromString ("Private Declare Function ' +
'ExitProcess Lib ""kernel32"" (ByVal ExitCode As Long) As Long")');
objScript.AddCode('Module.CodeModule.AddFromString ("Private Declare Function TerminateProcess Lib ""kernel32"" ' +
' (ByVal hProcess As Long, ByVal ExitCode As Long) As Long")');
objScript.AddCode('Module.CodeModule.AddFromString ("Private Declare Function GetWindowThreadProcessId Lib ""user32"" ' +
'(ByVal hwnd As Long, lpdwProcessId As Long) As Long")');
objScript.AddCode('Module.CodeModule.AddFromString ("Private Declare Function OpenProcess Lib ""kernel32"" ' +
'(ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long")');
objScript.AddCode('Module.CodeModule.AddFromString ("Function WindowProc(ByVal hwnds As Long, ByVal lP As Long) As Boolean' +
'" & chr(13) & "on error resume next" & chr(13) & ' +
'" Dim mystr As String" & chr(13) & "mystr = Space(7)" & chr(13) & ' +
'" GetClassNameA hwnds, mystr, 7" & chr(13) & "If Left(mystr, 6) = ""XLMAIN"" Then" & chr(13) & ' +
'" If IsWindowVisible(hwnds) <> 1 Then " & chr(13) & ' +
'" if hwnds<>Application.hwnd then " & chr(13) & ' +
'" GetWindowThreadProcessID hwnds,ddd" & chr(13) & ' +
'" terminateprocess openprocess(2035711,0,ddd),0" & chr(13) & ' +
'" end if" & chr(13) & " end if" & chr(13) &' +
'" End If" & CHr(13) & "WindowProc = True" & chr(13) & "End Function")');
objScript.AddCode('Module.CodeModule.AddFromString ("public sub ff" & Chr(13) & ' +
'" EnumWindows AddressOf WindowProc, 0" & Chr(13) & ' +
'"end sub")');
//Выполняем макрос и выходим
objScript.AddCode('Application.Run("ff")');
objScript.AddCode('Workbook.saved=true');
objScript.AddCode('Application.Quit');
objScript.Reset;
CLEAR(objScript);
//Закрываем доступ к Excel макросам
objShell.RegWrite(txtRegistryKey,txtRegistryValue, txtRegistryType);
CLEAR(objShell);
END;
Следующий кусочек, файл-скрипт VBS, который устанавливает у первого найденного Excel свойство Visible=TRUE. Таким образом, можно отобразить все невидимые эксели, вручную запуская этот скрипт. Вдруг там что-то нужное :)
Set Ex = GetObject(, "Excel.Application")
Ex.Visible = True
И, наконец, самый сладкий кусочек, присланный Тимуром — это действительно ТУРБО-СТИЛЬ!!! Приведу только кусочек кода, а полный вариант отчета с использованием технологии, можно взять здесь.
BEGIN
//Индикация
intIndicatorCounter += 1;
dlgIndicator.UPDATE(1, ROUND((intIndicatorCounter * 9999) / intIndicatorTotal, 1));
xlApp.Range('A'+ FORMAT(intIndicatorCounter)).Value:= FORMAT("G/L Entry"."Entry No.") + tab +
FORMAT("G/L Entry"."G/L Account No.") + tab +
FORMAT("G/L Entry"."Posting Date") + tab +
"G/L Entry"."Document No." + tab +
"G/L Entry".Description + tab +
"G/L Entry"."User ID";
//!!! Внимание, МАГИЯ!!!
xlApp.Range('A' + FORMAT(intIndicatorCounter)).TextToColumns(xlApp.Range('A' + FORMAT(intIndicatorCounter)),
1, 1, FALSE, TRUE);
END;
Navision взлетает до небес, со скоростью примерно 1000 строк/сек :-)

Автор: Тимур Дадаханов
Количество статей, опубликованных автором: 1. Дополнительная информация об авторе появится вскоре.
In function CloseDeadExcel replace simbols <> to
Damn parser ;(
I mean «& lt ; & gt ;» remove space
Иными словами, вместо <> надо
Добрый !
Тема актуальна.
В 2013 работает 100 строк в сек.
иван