Delphi. OLE Automation (COM). MS Word. Макросы

На предыдущую страницу…

Далее (см. ниже), VB — Visual Basic.

  • Word_Macros_VBModule_Create — создать VB модуль в документе MS Word с заданным именем. Если модуль уже существует, то вернуть ссылку на него;
  • Word_Macros_VBModule_Get — получить ссылку на VB модуль в документе MS Word по его имени (идентификатору);
  • Word_Macros_VBModule_Find — найти (проверить существование) VB модуль в документе MS Word по его имени (идентификатору);
  • Word_Macros_VBModule_Delete — удалить VB модуль в документе MS Word по его имени (идентификатору);
  • Word_Macros_Create — создать макрос в документе MS Word (вариант-1);
  • Word_Macros_Create — создать макрос в документе MS Word (вариант-2);
  • Word_Macros_Run — выполнить макрос (без параметров) для активного документа MS Word;
  • Word_Macros_Run_1 — выполнить макрос с одним строковым параметром для активного документа MS Word;
  • Word_Macros_Run_2 — выполнить макрос с двумя строковым параметром для активного документа MS Word.

Ссылку на файл ZIP-архива с примером — см. в конце этого документа.

function Word_Macros_VBModule_Create(vDoc:variant; ModuleName:string; YesCodeModuleClear:boolean=false): variant;
//создать VB модуль в документе MS Word с заданным именем. Если модуль уже существует, то вернуть ссылку на него
//vDoc - ссылка на документ MS Word (см. здесь)
//ModuleName - имя (идентификатор) VB-модуля
//YesCodeModuleClear - если =TRUE, то содержимое существующего VB-модуля очищается
//Возвращаемое значение - ссылка на VB-модуль
Var
  vVbProj : variant;
  vVbCode : variant;
  N:integer;
begin
  Result:=UnAssigned;
  ModuleName:=trim(ModuleName);
  if length(ModuleName)>0 then begin
     if not VarIsEmpty(vDoc) then begin
        Result:=Word_Macros_VBModule_Get(vDoc, ModuleName);
        if VarIsEmpty(Result) then begin
           vVbProj := vDoc.VBProject;
           Result := vVbProj.VBComponents.Add(vbext_ct_StdModule);
           Result.Name := ModuleName;
        end;
        if YesCodeModuleClear then begin
           if not VarIsEmpty(Result) then begin
              vVbCode := Result.CodeModule;
              if not VarIsEmpty(vVbCode) then begin
                 vVbCode.DeleteLines(1, vVbCode.CountOfLines);
              end;
           end;
        end;
     end;
  end;
end;

function Word_Macros_VBModule_Get(vDoc:variant; ModuleName:string):variant;
//получить ссылку на VB модуль в документе MS Word по его имени (идентификатору)
//vDoc - ссылка на документ MS Word (см. здесь)
//ModuleName - имя (идентификатор) VB-модуля
//Возвращаемое значение - ссылка на VB-модуль
Var
  vVbProj : variant;
  i:integer;
begin
  Result:=UnAssigned;
  ModuleName:=trim(ModuleName);
  if length(ModuleName)>0 then begin
     if not VarIsEmpty(vDoc) then begin
        ModuleName:=UpperCase(ModuleName);
        vVbProj := vDoc.VBProject;
        if not VarIsEmpty(vVbProj) then begin
           i:=0;
           while i<vVbProj.VBComponents.Count do
           begin
            i:=i+1;
            if ModuleName = UpperCase(trim(vVbProj.VBComponents.item(i).Name)) then begin
               Result:=vVbProj.VBComponents.item(i);
               i:=vVbProj.VBComponents.Count+1; //Выход из цикла
            end;
          end;
        end;
     end;
  end;
end;

function Word_Macros_VBModule_Find(vDoc:variant; ModuleName:string):integer;
//найти (проверить существование) VB модуль в документе MS Word по его имени (идентификатору). Используется в Word_Macros_VBModule_Delete.
//vDoc - ссылка на документ MS Word (см. здесь)
//ModuleName - имя (идентификатор) VB-модуля
//Возвращаемое значение - порядковый номер VB-модуля в коллекции компонентов VB (или =0, если не найдено)
Var
  vVbProj : variant;
  i:integer;
begin
  Result:=0;
  ModuleName:=trim(ModuleName);
  if length(ModuleName)>0 then begin
     if not VarIsEmpty(vDoc) then begin
        ModuleName:=UpperCase(ModuleName);
        vVbProj := vDoc.VBProject;
        if not VarIsEmpty(vVbProj) then begin
           i:=0;
           while i<vVbProj.VBComponents.Count do
           begin
            i:=i+1;
            if ModuleName = UpperCase(trim(vVbProj.VBComponents.item(i).Name)) then begin
               Result:=i;
               i:=vVbProj.VBComponents.Count+1; //Выход из цикла
            end;
          end;
        end;
     end;
  end;
end;

function Word_Macros_VBModule_Delete(vDoc:variant; ModuleName:string):boolean;
//удалить VB модуль в документе MS Word по его имени  (идентификатору)
//vDoc - ссылка на документ MS Word (см. здесь)
//ModuleName - имя (идентификатор) VB-модуля
//Возвращаемое значение - результат операции
Var
  vVbProj : variant;
  N:integer;
begin
  Result:=false;
  ModuleName:=trim(ModuleName);
  if length(ModuleName)>0 then begin
     if not VarIsEmpty(vDoc) then begin
        N:=Word_Macros_VBModule_Find(vDoc, ModuleName);
        if N>0 then begin
           vVbProj := vDoc.VBProject;
           if not VarIsEmpty(vVbProj) then begin
              vVbProj.VBComponents.Remove(vVbProj.VBComponents.item(N));
              Result:=true;
           end;
        end;
     end;
  end;
end;

function Word_Macros_Create(vDoc:variant; ModuleName:string; MacrosName:String; sParams:string; ListText:TStrings):boolean;
//создать макрос в документе MS Word (вариант-1)
//vDoc - ссылка на документ MS Word (см. здесь)
//ModuleName - имя (идентификатор) VB-модуля
//MacrosName - имя (идентификатор) макроса
//sParams - параметры макроса (без круглых скобок)
//ListText - текст (тело) макроса
//Возвращаемое значение - результат операции
Var
  vVbModule, vVbCode:variant;
  i,N:integer;
  Sx:string;
  sCode:string;
begin
  Result:=false;
  ModuleName:=trim(ModuleName);
  if length(ModuleName)>0 then begin
     MacrosName:=trim(MacrosName);
     if length(MacrosName)>0 then begin
        if not VarIsEmpty(vDoc) then begin
           vVbModule:=Word_Macros_VBModule_Create(vDoc,ModuleName);
           if not VarIsEmpty(vVbModule) then begin
              vVbCode := vVbModule.CodeModule;
              if not VarIsEmpty(vVbCode) then begin
                 N:=0;
                 sParams:=trim(sParams);
                 sParams:='('+sParams+')';
                 sCode:='';
                 Sx:='SUB' +' ' + MacrosName + sParams;
                 sCode:=sCode+Sx+#10+#13;
                 if ListText<>nil then begin
                    i:=-1;
                    while i<(ListText.Count-1) do
                     begin
                      i:=i+1;
                      Sx:= ListText[i];
                      sCode:=sCode+Sx+#10{+#13};
                    end;
                 end;
                 Sx:='END SUB';
                 sCode:=sCode+Sx+#10+#13;
                 vVbCode.AddFromString(sCode);
                 Result:=true;
              end;
           end;
        end;
     end;
  end;
end;

function Word_Macros_Create(vDoc:variant; ModuleName:string; ListText:TStrings):boolean;
//создать макрос в документе MS Word (вариант-2)
//vDoc - ссылка на документ MS Word (см. здесь)
//ModuleName - имя (идентификатор) VB-модуля
//ListText - текст (тело) макроса
//Возвращаемое значение - результат операции
Var
  vVbModule, vVbCode:variant;
  i,N:integer;
  Sx:string;
  sCode:string;
begin
  Result:=false;
  ModuleName:=trim(ModuleName);
  if length(ModuleName)>0 then begin
     if not VarIsEmpty(vDoc) then begin
        vVbModule:=Word_Macros_VBModule_Create(vDoc,ModuleName);
        if not VarIsEmpty(vVbModule) then begin
           vVbCode := vVbModule.CodeModule;
           if not VarIsEmpty(vVbCode) then begin
              if Assigned(ListText) then begin
                 //ShowMessage(ListText.Text);
                 sCode:='';
                 i:=-1;
                 while i<(ListText.Count-1) do
                  begin
                   i:=i+1;
                   Sx:= ListText[i];
                   sCode:=sCode+Sx+#10{+#13};
                 end;
                 vVbCode.AddFromString(sCode);
              end;
              Result:=true;
           end;
        end;
     end;
  end;
end;


function Word_Macros_Run(msWord:variant; MacrosName:String):boolean;
//выполнить макрос (без параметров) для активного документа MS Word
//msWord - ссылка на приложение MS Word (или на документ MS Word), см. здесь
//MacrosName - имя (идентификатор) макроса
//Возвращаемое значение - результат операции
begin
  Result:=false;
  MacrosName:=trim(MacrosName);
  if length(MacrosName)>0 then begin
     if not VarIsEmpty(msWord) then begin
        msWord.Application.Run(MacrosName);
        Result:=true;
     end;
  end;
end;


function Word_Macros_Run_1(msWord:variant; MacrosName:String; sParam1:string):boolean;
//выполнить макрос с одним строковым параметром для активного документа MS Word
//msWord - ссылка на приложение MS Word (или на документ MS Word), см. здесь
//MacrosName - имя (идентификатор) макроса
//sParam1 - значение параметра
//Возвращаемое значение - результат операции
begin
  Result:=false;
  MacrosName:=trim(MacrosName);
  if length(MacrosName)>0 then begin
     if not VarIsEmpty(msWord) then begin
        msWord.Application.Run(MacrosName, sParam1);
        Result:=true;
     end;
  end;
end;


function Word_Macros_Run_2(msWord:variant; MacrosName:String; sParam1, sParam2:string):boolean;
//Выполнить макрос с двумя строковыми параметрами для активного документа
//msWord - ссылка на приложение MS Word (или на документ MS Word), см. здесь
//MacrosName - имя (идентификатор) макроса
//sParam1 - значение 1-го параметра
//sParam2 - значение 2-го параметра
//Возвращаемое значение - результат операции
begin
  Result:=false;
  MacrosName:=trim(MacrosName);
  if length(MacrosName)>0 then begin
     if not VarIsEmpty(msWord) then begin
        msWord.Application.Run(MacrosName, sParam1, sParam2);
        Result:=true;
     end;
  end;
end;

Документ в формате PDF можно скачать здесь: OLE_Word_Ex_02.pdf.

Дополнительно к этому документу прилагаются исходные тексты как самих функций (проект в среде Delphi 10.2 Tokyo), так и программа тестирования (с исходниками, ясное дело).
Имя файла ZIP-архива: OLE_Word_Ex_02_pas.zip (скачать).

На предыдущую страницу…

Дата: 19.10.2022