Excel в стиле Ultra (часть 2)

Эта статья — продолжение темы, начатой в «Excel в стиле Ultra»

Как-то я задавал вопрос о том, что делать с невидимыми экселями, которые остаются висеть в памяти из-за ошибок. Тимур Дадаханов (timur-dadakhanov@rambler.ru) прислал свое решение этого и сразу целого вороха других проблемсов. Ему слово :-)

К сожалению, с самого начала я не заметил в вашей статье ключевую фразу «При возникновении ошибки этот невидимый эксель…». Поэтому, когда запускать эту функцию по закрытию всех невидимых экселей, я не знаю. может и не нужно вовсе. Ну, например, при выгрузки данных в шаблон Excel, ее можно применить, если предыдущая выгрузка была отменена пользователем. тогда при повторном запуске отчета, функция определит «дохлый» excel и закроет его, и новый отчет выгрузится без ошибок. В ней используется техника WinAPI. С помощью этой техники можно с навиженом, да и с любым приложением делать что угодно. Единственный минус – должен сначала загрузиться Excel, а это на первую загрузку Excel в системе требует времени.

PROCEDURE CloseDeadExcel();
    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. Таким образом, можно отобразить все невидимые эксели, вручную запуская этот скрипт. Вдруг там что-то нужное :)

ShowFirstExcel.vbs

Set Ex = GetObject(, "Excel.Application")
Ex.Visible = True

И, наконец, самый сладкий кусочек, присланный Тимуром — это действительно ТУРБО-СТИЛЬ!!! Приведу только кусочек кода, а полный вариант отчета с использованием технологии, можно взять здесь.

OnAfterGetRecord=
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. Дополнительная информация об авторе появится вскоре.

Комментарии (4 комментария)

  1. rejector

    In function CloseDeadExcel replace simbols <> to

  2. rejector

    Damn parser ;(

    I mean «& lt ; & gt ;» remove space

  3. Васятко

    Иными словами, вместо <> надо

  4. Иван

    Добрый !

    Тема актуальна.
    В 2013 работает 100 строк в сек.

    иван

Добавить комментарий