Форум поддержки пользователей. LibreOffice, Apache OpenOffice, OpenOffice.org

Форум поддержки пользователей. LibreOffice, Apache OpenOffice, OpenOffice.org

1 Декабрь 2020, 08:16 *
Добро пожаловать, Гость. Пожалуйста, войдите или зарегистрируйтесь.
Вам не пришло письмо с кодом активации?

Войти
Новости: Вы можете задать вопрос по LibreOffice или Apache OpenOffice без регистрации, используя форму
 
   Начало   Помощь Поиск Войти Регистрация    задать вопрос  
Страниц: 1   Вниз
  Печать  
Автор Тема: Экспорт макроса  (Прочитано 704 раз)
0 Пользователей и 1 Гость смотрят эту тему.
Fiona
Форумчанин
***
Offline Offline

Сообщений: 81


« Стартовое сообщение: 28 Октябрь 2020, 05:51 »

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

Подскажите, пожалуйста, как удалять и добавлять макросы в вызываемом файле макросом активного файла (не через интерфейс). В прототипе 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
Форумчанин
***
Offline Offline

Сообщений: 1 314


« Ответ #1: 28 Октябрь 2020, 08:54 »

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

Руб. за сто, что Питоньяк
Любит водку и коньяк!
Потому что мне, без оных, -
Не понять его никак...
Fiona
Форумчанин
***
Offline Offline

Сообщений: 81


« Ответ #2: 29 Октябрь 2020, 08:22 »

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

Сообщений: 81


« Ответ #3: 20 Ноябрь 2020, 07:05 »

Добрый день!
Что-то нарыла у Питоньяка, примеров очень мало, не понятно назначение промежуточных операций.
Получилось так:
Код:
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
Форумчанин
***
Offline Offline

Пол: Мужской
Сообщений: 229


WWW
« Ответ #4: 20 Ноябрь 2020, 15:37 »

Добрый день!

Я бы не рекомендовал писать в библиотеку 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
Форумчанин
***
Offline Offline

Сообщений: 81


« Ответ #5: 20 Ноябрь 2020, 16:16 »

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

Сообщений: 81


« Ответ #6: 24 Ноябрь 2020, 13:18 »

Добрый день!
Выкопировка из книги не работает! Начиная со строки
Код:
sNames = oSrcLib.getElementNames()
Список модулей передается в переменную только при обращении через контейнер
Код:
sNames = oSrcLib.getModuleContainer().getElementNames()
Судя по выводу в отладчике, модуль читается, но замещения модуля
Код:
oDestLib.replaceByName(sNames(i), oSrcLib.getByName(sNames(i)))
не происходит. Собственно, как удаления и вставки. В LO пароль на библиотеку не стоит, не знаю, где искать причину.
Записан
sokol92
Форумчанин
***
Offline Offline

Пол: Мужской
Сообщений: 229


WWW
« Ответ #7: 24 Ноябрь 2020, 15:56 »

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

Владимир.
Fiona
Форумчанин
***
Offline Offline

Сообщений: 81


« Ответ #8: 24 Ноябрь 2020, 16:42 »

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


* Снимок экрана 2020-11-23 125121.jpg (147.53 Кб, 1110x663 - просмотрено 6 раз.)

* Снимок экрана 2020-11-24 204106.jpg (173.77 Кб, 1179x685 - просмотрено 5 раз.)
Записан
sokol92
Форумчанин
***
Offline Offline

Пол: Мужской
Сообщений: 229


WWW
« Ответ #9: 24 Ноябрь 2020, 16:56 »

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

Владимир.
Fiona
Форумчанин
***
Offline Offline

Сообщений: 81


« Ответ #10: 24 Ноябрь 2020, 17:00 »

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

Пол: Мужской
Сообщений: 229


WWW
« Ответ #11: 24 Ноябрь 2020, 17:01 »

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

Владимир.
Fiona
Форумчанин
***
Offline Offline

Сообщений: 81


« Ответ #12: 26 Ноябрь 2020, 04:42 »

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

Пол: Мужской
Сообщений: 229


WWW
« Ответ #13: 26 Ноябрь 2020, 12:00 »

Успехов!
Записан

Владимир.
Страниц: 1   Вверх
  Печать  
 
Перейти в:  

Powered by MySQL Powered by PHP Powered by SMF 1.1.21 | SMF © 2006-2009, Simple Machines Valid XHTML 1.0! Valid CSS!