Макросы LO и "Сохранить Лист" в формате xls

Автор ASSEI, 22 марта 2017, 21:41

0 Пользователи и 1 гость просматривают эту тему.

ASSEI

Доброго всем вечера! подскажите как можно решить такой момент как из LO 5.3 макросом "Сохранить Лист" в формате xls. Заранее всем спасибо!

Rafik

Этот макрос вытащит один, указанный лист в новый документ и сохранит новую книгу в формате XLSSub One_sheet_to_XLS()
Dim oDoc1,oSheets1 As Object ' Документ куда тащим лист и его листы
Dim oDoc,oSheet As Object ' Документ откуда тащим и интересующий лист
Dim cFnm As String
' ==== Перетаскиваем интересующий лист из текущего документа
' Документ откуда
oDoc = ThisComponent ' Например, текущий документ
' Интересующий лист, который необходимо сохранить
oSheet = oDoc.Sheets(0) ' Например, первый лист документа
' Открываем пустой документ для импорта, это будет временный файл
Set oDesk = createUnoService("com.sun.star.frame.Desktop")
    oDoc1 = oDesk.LoadComponentFromUrl("private:factory/scalc", "_blank", 63, Array())
' Импорт листа в пустой документ (временный файл)
oSheets1 = oDoc1.getSheets()
oSheets1.importSheet(oDoc,oSheet.LinkDisplayName,0)
' Удаляем ненужные листы в новом документе
For ii = 1 To oDoc1.Sheets.Count -1
oDoc1.Sheets.removeByName(oDoc1.Sheets(ii).Name)
Next
'==== Лист перетащен
'==== Будем сохранять туда же, где сам документ
cFnm = convertFromURL(oDoc.URL)
aFnm = Split(cFnm,getPathSeparator())
aFnm(Ubound(aFnm)) = "Новое имя файла"+".xls"
'=== путь и имя файла есть, можем сохранить
' Зададим формат для сохранения
Dim args(0) as new com.sun.star.beans.PropertyValue
args(0).Name = "FilterName"
args(0).Value = "MS Excel 97" 'формат Excel 97
' Сохраним
oDoc1.storeToURL(convertToURL(join(aFnm,getPathSeparator())), args())
' Закроем временный файл без сохранения
oDoc1.Close(True)
End Sub

ASSEI


v.kolesnikov@original-gro

Цитата: Rafik от 23 марта 2017, 07:50
Этот макрос вытащит один, указанный лист в новый документ и сохранит новую книгу в формате XLSSub One_sheet_to_XLS()
Dim oDoc1,oSheets1 As Object ' Документ куда тащим лист и его листы
Dim oDoc,oSheet As Object ' Документ откуда тащим и интересующий лист
Dim cFnm As String
' ==== Перетаскиваем интересующий лист из текущего документа
' Документ откуда
oDoc = ThisComponent ' Например, текущий документ
' Интересующий лист, который необходимо сохранить
oSheet = oDoc.Sheets(0) ' Например, первый лист документа
' Открываем пустой документ для импорта, это будет временный файл
Set oDesk = createUnoService("com.sun.star.frame.Desktop")
    oDoc1 = oDesk.LoadComponentFromUrl("private:factory/scalc", "_blank", 63, Array())
' Импорт листа в пустой документ (временный файл)
oSheets1 = oDoc1.getSheets()
oSheets1.importSheet(oDoc,oSheet.LinkDisplayName,0)
' Удаляем ненужные листы в новом документе
For ii = 1 To oDoc1.Sheets.Count -1
oDoc1.Sheets.removeByName(oDoc1.Sheets(ii).Name)
Next
'==== Лист перетащен
'==== Будем сохранять туда же, где сам документ
cFnm = convertFromURL(oDoc.URL)
aFnm = Split(cFnm,getPathSeparator())
aFnm(Ubound(aFnm)) = "Новое имя файла"+".xls"
'=== путь и имя файла есть, можем сохранить
' Зададим формат для сохранения
Dim args(0) as new com.sun.star.beans.PropertyValue
args(0).Name = "FilterName"
args(0).Value = "MS Excel 97" 'формат Excel 97
' Сохраним
oDoc1.storeToURL(convertToURL(join(aFnm,getPathSeparator())), args())
' Закроем временный файл без сохранения
oDoc1.Close(True)
End Sub

А как сделать, что-бы все листы документа сохранились как отдельные книги?

v.kolesnikov@original-gro

Sub One_sheet_to_XLS()
   Dim oDoc1,oSheets1 As Object ' Документ куда тащим лист и его листы
   Dim oDoc,oSheet As Object ' Документ откуда тащим и интересующий лист
   Dim cFnm As String
' ==== Перетаскиваем интересующий лист из текущего документа
   ' Документ откуда
   oDoc = ThisComponent ' Например, текущий документ
   ' Интересующий лист, который необходимо сохранить
   oSheet = oDoc.Sheets(0) ' Например, первый лист документа
   ' Открываем пустой документ для импорта, это будет временный файл
   Set oDesk = createUnoService("com.sun.star.frame.Desktop")
    oDoc1 = oDesk.LoadComponentFromUrl("private:factory/scalc", "_blank", 63, Array())   
   ' Импорт листа в пустой документ (временный файл)
   oSheets1 = oDoc1.getSheets()
   oSheets1.importSheet(oDoc,oSheet.LinkDisplayName,0)
   ' Удаляем ненужные листы в новом документе
   For ii = 1 To oDoc1.Sheets.Count -1
      oDoc1.Sheets.removeByName(oDoc1.Sheets(ii).Name)
   Next
'==== Лист перетащен
'==== Будем сохранять туда же, где сам документ
   cFnm = convertFromURL(oDoc.URL)
   aFnm = Split(cFnm,getPathSeparator())
   aFnm(Ubound(aFnm)) = "Линия 1"+".xls"
'=== путь и имя файла есть, можем сохранить
   ' Зададим формат для сохранения
   Dim args(0) as new com.sun.star.beans.PropertyValue
   args(0).Name = "FilterName"
   args(0).Value = "MS Excel 97" 'формат Excel 97
   ' Сохраним
   oDoc1.storeToURL(convertToURL(join(aFnm,getPathSeparator())), args())
   ' Закроем временный файл без сохранения
   oDoc1.Close(True)
   
   
   
      oSheet = oDoc.Sheets(1) ' Например, первый лист документа
   ' Открываем пустой документ для импорта, это будет временный файл
   Set oDesk = createUnoService("com.sun.star.frame.Desktop")
    oDoc1 = oDesk.LoadComponentFromUrl("private:factory/scalc", "_blank", 63, Array())   
   ' Импорт листа в пустой документ (временный файл)
   oSheets1 = oDoc1.getSheets()
   oSheets1.importSheet(oDoc,oSheet.LinkDisplayName,0)
   ' Удаляем ненужные листы в новом документе
   For ii = 1 To oDoc1.Sheets.Count -1
      oDoc1.Sheets.removeByName(oDoc1.Sheets(ii).Name)
   Next
'==== Лист перетащен
'==== Будем сохранять туда же, где сам документ
   cFnm = convertFromURL(oDoc.URL)
   aFnm = Split(cFnm,getPathSeparator())
   aFnm(Ubound(aFnm)) = "Линия 2"+".xls"
'=== путь и имя файла есть, можем сохранить

   ' Сохраним
   oDoc1.storeToURL(convertToURL(join(aFnm,getPathSeparator())), args())
   ' Закроем временный файл без сохранения
   oDoc1.Close(True)
   
   
      oSheet = oDoc.Sheets(2) ' Например, первый лист документа
   ' Открываем пустой документ для импорта, это будет временный файл
   Set oDesk = createUnoService("com.sun.star.frame.Desktop")
    oDoc1 = oDesk.LoadComponentFromUrl("private:factory/scalc", "_blank", 63, Array())   
   ' Импорт листа в пустой документ (временный файл)
   oSheets1 = oDoc1.getSheets()
   oSheets1.importSheet(oDoc,oSheet.LinkDisplayName,0)
   ' Удаляем ненужные листы в новом документе
   For ii = 1 To oDoc1.Sheets.Count -1
      oDoc1.Sheets.removeByName(oDoc1.Sheets(ii).Name)
   Next
'==== Лист перетащен
'==== Будем сохранять туда же, где сам документ
   cFnm = convertFromURL(oDoc.URL)
   aFnm = Split(cFnm,getPathSeparator())
   aFnm(Ubound(aFnm)) = "Линия 3"+".xls"
'=== путь и имя файла есть, можем сохранить

   ' Сохраним
   oDoc1.storeToURL(convertToURL(join(aFnm,getPathSeparator())), args())
   ' Закроем временный файл без сохранения
   oDoc1.Close(True)
   
      oSheet = oDoc.Sheets(3) ' Например, первый лист документа
   ' Открываем пустой документ для импорта, это будет временный файл
   Set oDesk = createUnoService("com.sun.star.frame.Desktop")
    oDoc1 = oDesk.LoadComponentFromUrl("private:factory/scalc", "_blank", 63, Array())   
   ' Импорт листа в пустой документ (временный файл)
   oSheets1 = oDoc1.getSheets()
   oSheets1.importSheet(oDoc,oSheet.LinkDisplayName,0)
   ' Удаляем ненужные листы в новом документе
   For ii = 1 To oDoc1.Sheets.Count -1
      oDoc1.Sheets.removeByName(oDoc1.Sheets(ii).Name)
   Next
'==== Лист перетащен
'==== Будем сохранять туда же, где сам документ
   cFnm = convertFromURL(oDoc.URL)
   aFnm = Split(cFnm,getPathSeparator())
   aFnm(Ubound(aFnm)) = "Линия 4"+".xls"
'=== путь и имя файла есть, можем сохранить

   ' Сохраним
   oDoc1.storeToURL(convertToURL(join(aFnm,getPathSeparator())), args())
   ' Закроем временный файл без сохранения
   oDoc1.Close(True)
   
   
      oSheet = oDoc.Sheets(4) ' Например, первый лист документа
   ' Открываем пустой документ для импорта, это будет временный файл
   Set oDesk = createUnoService("com.sun.star.frame.Desktop")
    oDoc1 = oDesk.LoadComponentFromUrl("private:factory/scalc", "_blank", 63, Array())   
   ' Импорт листа в пустой документ (временный файл)
   oSheets1 = oDoc1.getSheets()
   oSheets1.importSheet(oDoc,oSheet.LinkDisplayName,0)
   ' Удаляем ненужные листы в новом документе
   For ii = 1 To oDoc1.Sheets.Count -1
      oDoc1.Sheets.removeByName(oDoc1.Sheets(ii).Name)
   Next
'==== Лист перетащен
'==== Будем сохранять туда же, где сам документ
   cFnm = convertFromURL(oDoc.URL)
   aFnm = Split(cFnm,getPathSeparator())
   aFnm(Ubound(aFnm)) = "Линия 5"+".xls"
'=== путь и имя файла есть, можем сохранить

   ' Сохраним
   oDoc1.storeToURL(convertToURL(join(aFnm,getPathSeparator())), args())
   ' Закроем временный файл без сохранения
   oDoc1.Close(True)
   
   
   
   
   
   
End Sub


luu

#5
Цитата: Rafik от 23 марта 2017, 07:50Этот макрос вытащит один, указанный лист в новый документ и сохранит новую книгу в формате XLS
Sub One_sheet_to_XLS()
    Dim oDoc1,oSheets1 As Object ' Документ куда тащим лист и его листы
    Dim oDoc,oSheet As Object ' Документ откуда тащим и интересующий лист
    Dim cFnm As String
' ==== Перетаскиваем интересующий лист из текущего документа
    ' Документ откуда
    oDoc = ThisComponent ' Например, текущий документ
    ' Интересующий лист, который необходимо сохранить
    oSheet = oDoc.Sheets(0) ' Например, первый лист документа
    ' Открываем пустой документ для импорта, это будет временный файл
    Set oDesk = createUnoService("com.sun.star.frame.Desktop")
    oDoc1 = oDesk.LoadComponentFromUrl("private:factory/scalc", "_blank", 63, Array())   
    ' Импорт листа в пустой документ (временный файл)
    oSheets1 = oDoc1.getSheets()
    oSheets1.importSheet(oDoc,oSheet.LinkDisplayName,0)
    ' Удаляем ненужные листы в новом документе
    For ii = 1 To oDoc1.Sheets.Count -1
        oDoc1.Sheets.removeByName(oDoc1.Sheets(ii).Name)
    Next
'==== Лист перетащен
'==== Будем сохранять туда же, где сам документ
    cFnm = convertFromURL(oDoc.URL)
    aFnm = Split(cFnm,getPathSeparator())
    aFnm(Ubound(aFnm)) = "Новое имя файла"+".xls"
'=== путь и имя файла есть, можем сохранить
    ' Зададим формат для сохранения
    Dim args(0) as new com.sun.star.beans.PropertyValue
    args(0).Name = "FilterName"
    args(0).Value = "MS Excel 97" 'формат Excel 97
    ' Сохраним
    oDoc1.storeToURL(convertToURL(join(aFnm,getPathSeparator())), args())
    ' Закроем временный файл без сохранения
    oDoc1.Close(True)
End Sub

На это ругается:
aFnm = Split(cFnm,getPathSeparator())Переменная не определена

Как ее объявить?

sokol92

Владимир.

luu

Я объявлял как строку, поэтому не получалось
Dim aFnm As String
После того как указал
Dim aFnm() As Stringвсе получилоась

Спасибо

luu

При использовании макроса экспорт выполняется в новую книгу и стиль страницы становится Базовый. Как можно экспортировать лист вместе со стилем страницы, примененным к нему?

bigor

Цитата: luu от 27 августа 2023, 07:23Как можно экспортировать лист вместе со стилем страницы, примененным к нему?

А почему бы не сохранить первоначальный файл с новым именем, и затем уже удалить из него лишние листы
Поддержать наш форум можно здесь

luu

Цитата: bigor от 27 августа 2023, 09:25
Цитата: luu от 27 августа 2023, 07:23Как можно экспортировать лист вместе со стилем страницы, примененным к нему?

А почему бы не сохранить первоначальный файл с новым именем, и затем уже удалить из него лишние листы

И то верно. Но при реализации наткнулся на проблемы. Использую такую конструкцию:
Sub Export_RemoveSheets (FileName)

REM --->
Dim param1(1) As new com.sun.star.beans.PropertyValue
Dim Arg(0) As new com.sun.star.beans.PropertyValue
Dim prop(0) as new com.sun.star.beans.PropertyValue
Dim Doc as Object
Dim FolderName, ExportFileName as String

    prop(0).Name="Hidden"
    prop(0).Value= true
GlobalScope.BasicLibraries.LoadLibrary("Tools")
REM --->

Doc = ThisComponent

FolderName = convertFromURL(DirectoryNameoutofPath(ThisComponent.URL, "/") & "/")
ExportFileName = FileName

REM Export XLS:
  Param1(0).Name =  "FilterName"
  Param1(0).Value = "MS Excel 97"
  Param1(1).Name = "FilterData"
  Param1(1).Value = Arg()

Doc.storeToURL ConvertToURL(FolderName & ExportFileName & ".xls"), Param1()

    oDoc2 = StarDesktop.loadComponentFromUrl(convertToURL(FolderName & ExportFileName & ".xls"), "_blank", 0, Prop())
    oSheets = oDoc2.getSheets()
   
SName = "Лист 1"
If oSheets.hasByName(SName) Then oSheets.removeByName(SName)
SName = "Лист 2"
If oSheets.hasByName(SName) Then oSheets.removeByName(SName)
SName = "Лист 3"
If oSheets.hasByName(SName) Then oSheets.removeByName(SName)

  oDoc2.Store()
  oDoc2.Close(true)
 
Print "Сформирован файл: " & ExportFileName

End Sub

Но если Листы 1, 2, 3 защищены, то не выходит. Пользователю нужно ввести пароль.
И еще вопрос, можно ли удалять листы не указывая все явно, а наоборот указать только нужный лист, а остальные удалить?

bigor

Цитата: luu от 27 августа 2023, 11:33Но если Листы 1, 2, 3 защищены, то не выходит
если пароль одинаковый для всех файлов, можно прописать его в макросе.
Цитата: luu от 27 августа 2023, 11:33указать только нужный лист
Чуть подправил ваш код. В ResSheet задаем имя листа, который нужно оставить
Sub Export_RemoveSheets (FileName)

REM --->
Dim param1(0) As new com.sun.star.beans.PropertyValue
Dim prop(0) as new com.sun.star.beans.PropertyValue
Dim Doc as Object
Dim FolderName, ExportFileName as String

    prop(0).Name="Hidden"
    prop(0).Value= true
GlobalScope.BasicLibraries.LoadLibrary("Tools")
REM --->

Doc = ThisComponent

FolderName = convertFromURL(DirectoryNameoutofPath(ThisComponent.URL, "/") & "/")
ExportFileName = FileName

REM Export XLS:
  Param1(0).Name =  "FilterName"
  Param1(0).Value = "MS Excel 97"

Doc.storeToURL ConvertToURL(FolderName & ExportFileName & ".xls"), Param1()

    oDoc2 = StarDesktop.loadComponentFromUrl(convertToURL(FolderName & ExportFileName & ".xls"), "_blank", 0, Prop())
    oSheets = oDoc2.getSheets()
    ResSheet = "Лист2"
    for i =oSheets.count-1 to 0 step -1
    if oSheets(i).name <> ResSheet then
    oSheets.removeByName(oSheets(i).name)
    end if
    next i

  oDoc2.Store()
  oDoc2.Close(true)
 
Print "Сформирован файл: " & ExportFileName

End Sub

Поддержать наш форум можно здесь

luu

Спасибо!
Еще один вопрос возник, а при таком экспорте, можно ли в итоговом документы удалить все макросы? Ведь они там, по сути, не нужны

sokol92

Так Вы всё равно сохраняете документ 2 раза. Первый раз сохраните как .xlsx, все макросы при этом должны исчезнуть.
Владимир.

luu

Цитата: sokol92 от 28 августа 2023, 19:53Так Вы всё равно сохраняете документ 2 раза. Первый раз сохраните как .xlsx, все макросы при этом должны исчезнуть.
А если хочется сохранять в ods? Как быть в таком случае?