Экспорт макроса

[Fiona]

Здравствуйте!

Подскажите, пожалуйста, как удалять и добавлять макросы в вызываемом файле макросом активного файла (не через интерфейс). В прототипе excel это выглядит так:

Код Выделить Развернуть


...
    Set objExcel = ThisWorkbook
    Set objVBProject = objExcel.VBProject
    Dim objWindow
    DoEvents2
    For Each objWindow In objVBProject.VBE.Windows
        If objWindow.Type = vbext_wt_ProjectWindow Then ' vbext_wt_ProjectWindow =6
            objWindow.Visible = True
            objWindow.SetFocus
            DoEvents2
        End If
    Next
    Set objVBProject.VBE.ActiveVBProject = objVBProject
    SendKeys "~PASSWORD~", True
   
    Set objExcel = PatchFile
    Set objVBProject = objExcel.VBProject
    DoEvents2
    For Each objWindow In objVBProject.VBE.Windows
        If objWindow.Type = vbext_wt_ProjectWindow Then ' vbext_wt_ProjectWindow =6
            objWindow.Visible = True
            objWindow.SetFocus
            DoEvents2
        End If
    Next
    Set objVBProject.VBE.ActiveVBProject = objVBProject
    DoEvents2
    SendKeys "~PASSWORD~", True
    DoEvents2
   
Set DestinationModule = PatchFile.VBProject.VBComponents("Module1").CodeModule
Set SourceModule = ThisWorkbook.VBProject.VBComponents("Module1").CodeModule

    For i = 1 To DestinationModule.CountofLines
    With DestinationModule
        .DeleteLines 1
    End With
    Next
    DoEvents2
   
newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 1
waitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait waitTime
DestinationModule.AddFromString SourceModule.Lines(1, SourceModule.CountofLines)
DoEvents2
...


А как можно переписать это для LO, что можно почитать?

Спасибо.

[economist]

У Питоньяка в 2х книжках на русском.

[Fiona]

Может быть я слишком по диагонали смотрю... Там в основном про работу с библиотеками написано. Или нет смысла читать модуль построчно, если можно использовать replaceByName? Попробую, спасибо.

[Fiona]

Добрый день!
Что-то нарыла у Питоньяка, примеров очень мало, не понятно назначение промежуточных операций.
Получилось так:

Код Выделить Развернуть


oSrcLibs = ThisComponent.getLibraryContainer()
oDestLibs = PatchFileLO.getLibraryContainer()

if oSrcLibs = oSrcLibs.hasByName("VBAProject") Then

oSrcLib = oSrcLibs.getByName("VBAProject")
oSrcMods = oSrcLib.getModuleContainer()
If NOT IsNull(oSrcMods) Then
If oSrcMods.hasByName("VGO1") Then
oSrcMod = oSrcMods.getByName("VGO1")
End If
End If
End If

if oDestLibs = oDestLibs.hasByName("VBAProject") Then

oDestLib = oDestLibs.getByName("VBAProject")
oDestMods = oDestLib.getModuleContainer()
If NOT IsNull(oDestMods) Then
If oDestMods.hasByName("VGO1") Then
oDestMod = oDestMods.getByName("VGO1")
oDestMods.removeByName("VGO1")
End If
End If
End If

oDestLib.insertByName("VGO1", oSrcMods.getByName("VGO1"))


Видимо, где-то что-то не так применила - не работает: не удаляет старый модуль и не вставляет новый.
Помогите, пожалуйста, как исправить?

[sokol92]

Добрый день!

Я бы не рекомендовал писать в библиотеку VBAProject, так как эта библиотека имеет специальное назначение. Читать из этой библиотеки вполне возможно. Ниже используется соответствующий макрос A.Питоньяка. Оба документа должны быть открыты.

Код Выделить Развернуть

Option Explicit

' Копируем библиотеку VBAProject книги VBAExample.xlsm в библиотеку Newlib документа CalcExample.ods
Sub Test
  Dim oDocSrc, oDocDest, oSrcLibs, oDestLibs, srcLib As String, destLib As String

  oDocSrc =FindDocByTitle("VBAExample.xlsm")
  oDocDest=FindDocByTitle("CalcExample.ods")
 
  oSrcLibs=oDocSrc.BasicLibraries
  oDestLibs=oDocDest.BasicLibraries
 
  AddOneLib "VBAProject", "NewLib",  oSrcLibs, oDestLibs, True
End Sub

' Макрос из книги А.Питоньяка OOME_4_0.odt
REM sSrcLib is the name of the source library contained in oSrcLibs
REM sDestLib is the name of the source library contained in oDestLibs
REM oSrcLibs is the source library container
REM oDestLibs is the destination library container
REM if bClearDest is True, then the destination library is cleared
Sub AddOneLib(sSrcLib$, sDestLib$, oSrcLibs, oDestLibs, bClearDest As Boolean)
  Dim oSrcLib   'The source library to copy
  Dim oDestLib  'The destination library to receive the modules in oSrcLib
  Dim sNames
  Dim i%
 
  REM If there is no destination library then simply return
  If IsNull(oDestLibs) OR IsEmpty(oDestLibs) Then
    Exit Sub
  End If

  REM Clear the destination library if requested
  If bClearDest AND oDestLibs.hasByName(sDestLib) Then
    oDestLibs.removeLibrary(sDestLib)
  End If

  REM If there is no source library, then there is nothing else to do
  If IsNull(oSrcLibs) OR IsEmpty(oSrcLibs) Then
    Exit Sub
  End If

  REM If the source library does not exist, then there is nothing else to do
  If NOT oSrcLibs.hasByName(sSrcLib) Then
    Exit Sub
  End If

  REM If the destination library does not exist, then create it
  If NOT oDestLibs.hasByName(sDestLib) Then
    oDestLibs.createLibrary(sDestLib)
  End If

  REM This is where the real fun begins!
  REM It may seem obvious, but the libraries must be loaded first.
  REM Common mistake to not load the libraries first!
  oSrcLibs.loadLibrary(sSrcLib)
  oDestLibs.loadLibrary(sDestLib)

  REM Get the source and destination libraries
  REM Get all of the contained modules that should be copied
  oSrcLib = oSrcLibs.getByName(sSrcLib)
  oDestLib = oDestLibs.getByName(sDestLib)
  sNames = oSrcLib.getElementNames()

  REM For each module, either add it or replace it
  For i = LBound(sNames) To UBound(sNames)
    If oDestLib.hasByName(sNames(i)) Then
      oDestLib.replaceByName(sNames(i), oSrcLib.getByName(sNames(i)))
    Else
      oDestLib.insertByName(sNames(i), oSrcLib.getByName(sNames(i)))
    End If
  Next
End Sub

' Ищет среди открытых по заголовку и возвращает документ (объект).
' Title: заголовок документа.
Function FindDocByTitle(Byval Title As String) As Object
  Dim vEnumerate      'Enumeration object
  Dim vComp           'Single component
  vEnumerate = StarDesktop.GetComponents.createEnumeration
  Do While vEnumerate.hasMoreElements()   'Are there any elements to retrieve?
    vComp = vEnumerate.nextElement()      'Get next element
    If LCase(vComp.Title)=LCase(Title) Then
      Set FindDocByTitle = vComp
      Exit Function
    End If
  Loop
End Function

[Fiona]

Спасибо, Владимир!
Я из этого раздела и пыталась написать то, что мне нужно. Буду экспериментировать дальше!

[Fiona]

Добрый день!
Выкопировка из книги не работает! Начиная со строки

Код Выделить Развернуть


sNames = oSrcLib.getElementNames()

Список модулей передается в переменную только при обращении через контейнер

Код Выделить Развернуть


sNames = oSrcLib.getModuleContainer().getElementNames()

Судя по выводу в отладчике, модуль читается, но замещения модуля

Код Выделить Развернуть


oDestLib.replaceByName(sNames(i), oSrcLib.getByName(sNames(i)))

не происходит. Собственно, как удаления и вставки. В LO пароль на библиотеку не стоит, не знаю, где искать причину.

[sokol92]

Добрый день, Вера!
Макрос из #4 работает. В документе CalcExample.ods создается новая библиотека, в которую копируются все модули из VBAExample.xlsm (включая модули книги и листов, если имеются).
Код из #3 применять не стоит, так как он базируется на методах устаревшего интерфейса XStarBasicLibraryInfo.

[Fiona]

Здравствуйте, Владимир!
Во вложении снимок ошибки при использовании кода из #4 и с данными отладчика после изменения кода (в оригинале не работает).

[sokol92]

Еще раз проверил код из #4 - работает.
1. Вместо VBAExample.xlsm откройте в Calc свой файл (.xlsm) и поменяйте присвоение oDocSrc.
2. Откройте новый документ Calc и сохраните как  CalcExample.ods
3. Перепишите текст из #4 в новый модуль бибилиотеки Standard из My Macros и запустите макрос Test
4. По окончанию работы макроса в документе CalcExample.ods появится библиотека Newlib со всеми модулями из VBAProject

[Fiona]

То есть Вы хотите сказать, причина в имени библиотеки? я работаю именно с расширением ods для обоих файлов.

[sokol92]

Я бы не рекомендовал писать в библиотеку VBAProject, так как эта библиотека имеет специальное назначение

[Fiona]

Можно считать тему закрытой. Ошибка была в отсутствии обращения к свойству BasicLibraries. Теперь все работает даже с библиотекой VBAProject.
Всем огромное спасибо! Владимир - Вам отдельная благодарность

[sokol92]

Успехов!