помогите переделать на libreoffice сохранение листов книги как отдельных файлов

[jonn]

Здравствуйте, помогите переделать макрос, ссылка откуда скопировал, 2 вариант.

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


Sub SplitSheets2()
    Dim s As Worksheet
    Dim wb as Workbook
    Set wb = ActiveWorkbook
    For Each s In wb.Worksheets                                 'проходим во всем листам активной книги
        s.Copy                                                  'сохраняем лист как новый файл
        ActiveWorkbook.SaveAs wb.Path & "\" & s.Name & ".xlsx"  'сохраняем файл
    Next
End Sub

[mikekaganski]

Если этот код находится в библиотеке файла ODS/XLS[X], и в нём есть Option VBASupport 1, то он должен просто работать.
А в библиотеке программы надо что-то добавить, чтобы находить ActiveWorkbook. Если не ошибаюсь, sokol92 что-то такое приводил.

[jonn]

Спасибо, я тоже нашел, что надо добавить "Option VBASupport 1".
так же понял что можно путь сохранения указать вместо "\" "\home\работа".
а по ActiveWorkbook не смог найти информации что нужно сделать, чтобы не выскакивала ошибка.

[bigor]

"\home\работа"

так нужно перевести код на starbasic или чтобы  он работал и в MSO и в LO?

[jonn]

"\home\работа"

так нужно перевести код на starbasic или чтобы  он работал и в MSO и в LO?

работал в Libre office и linux.

[sokol92]

Самое короткоe решение - измените в первоначальном сценарии "\" на "/" - тогда будет работать и в Excel VBA и в LO Calc (все системы), при условии, что макрос находится в документе формата Excel.
Новые элекронные таблицы с именами листов сохраняются в папку текущего документа.

Если речь идет о "переезде" из MS Office в LibreOffice, то, разумеется, следует использовать объектную модель UNO.
Сейчас нет LO "под рукой", напишу позже, если коллеги не сделают это раньше. 

[sokol92]

Добрался до компьютера.

А в библиотеке программы надо что-то добавить, чтобы находить ActiveWorkbook. Если не ошибаюсь, sokol92 что-то такое приводил.

Еле нашел.
Такой скрипт должен выполняться:

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

Sub SplitSheets3()
    Dim s As Worksheet
    Dim wb as Workbook
    Dim xlApp
    Set xlApp=CreateUnoService("ooo.vba.excel.Application")
    Set wb = xlApp.ActiveWorkbook
    msgbox wb.activeSheet.dbg_properties()
    For Each s In wb.Worksheets                                      'проходим во всем листам активной книги
        s.Copy                                                       'сохраняем лист как новый файл
        xlApp.ActiveWorkbook.SaveAs wb.Path & "/" & s.Name & ".xlsx" 'сохраняем файл
    Next
End Sub

Только от него нет толку, поскольку документы сохраняются в формате, который Excel не понимает (на самом деле это шаблоны .xlt, в которые добавлен пустой проект. В моих опытах, если переименовать расширение в .xlt, то Excel откроет с предупреждениями).

Теперь макрос с "родным" интерфейсом.
Укажите в строке с приcвоением folder любую существующую папку, например:

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

folder=ConvertToUrl("/home/работа")            ' в эту папку записываем

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

' Сохраняет листы текущего документа Calc как отдельные документы
' c тем же названием.
Sub SplitSheets4()
   Dim oDoc As Object, oDoc2 As Object, oSheet As Object
   Dim shName As String, folder As String
   oDoc=ThisComponent      ' текущий документ Calc
   oDoc2 = StarDesktop.LoadComponentFromUrl("private:factory/scalc","_default",0,Array()) ' новый документ
   
   folder=ConvertToUrl("C:\temp\temp17")            ' в эту папку записываем
   
   For Each oSheet In oDoc.Sheets
     shName=oSheet.Name                             ' имя листа
                                                    ' если есть лист с таким именем, то переименовываем
     If oDoc2.Sheets.hasByName(shName) Then
       oDoc2.Sheets.getByName(shName).setName "Tmp___" & shName
     End If
     
     oDoc2.Sheets.importSheet oDoc, shName, 0       ' импортируем лист в начальную позицию
     ' Удаляем все листы, кроме первого
     Do While oDoc2.Sheets.Count>1
       oDoc2.Sheets.removeByName oDoc2.Sheets(oDoc2.Sheets.Count-1).Name
     Loop 

     oDoc2.storeToUrl folder & "/" & shName & ".ods", Array() ' сохранили     
   Next oSheet
   
   oDoc2.Close True                                  ' закрыли новый документ
   
End Sub


[jonn]

@sokol92
Спасибо большое! Посмотрел, все работает, сам бы не написал)
Да нужен был переезд в LO, так как переходим на Отечественное ПО, этот скрипт очень помогает в работе.