Добрый день! Проблема в том, что При экспорте из Calk на в?...

Автор ForumOOo (бот), 7 октября 2020, 15:22

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

ForumOOo (бот)

Компонент: Calc
Версия продукта: 5.x
Сборка: LibreOffice 7
ОС: Win7

Добрый день! Проблема в том, что При экспорте из Calk на выходе нужна таблица с форматированием, без формул и макросов.
Макрос экспортирует из Calk диапазон ячеек (таблицу) в новый файл ODT. Присваивает имя нового файла исходя из данных ячейки.

Sub CellRange_ODT

dim Arg(0) as new com.sun.star.beans.PropertyValue
dim args2(1) as new com.sun.star.beans.PropertyValue

 cPath = "file:///c:/"
 cFlNm=".odt"

 Doc = ThisComponent
 Sheet = Doc.Sheets.getByName("Nak")
 CellRange = Sheet.getCellRangeByName("$A2:$H$21")

 cName=Sheet.getCellByPosition(4,5).getString '$E$6. 'имя файла из ячейки
 
cFullName = cPath + cName + cFlNm ' Полное имя файла для сохранения
URL1 = ConvertToUrl(cFullName)' Преобразуем строку в URL для использования в команде сохранения
ThisComponent.storeToURL(URL1, args2()) ' Сохраняем.

End Sub

--
Подпись: DimS

sokol92

#1
Для сoхранения выделенного диапазона ячееек в формате ODT можно использовать следующий макрос (не изменяет буфер обмена):

Sub SelectionToODT(fileName)
  Dim v, oDoc
  v=ThisComponent.CurrentController.getTransferable()
  oDoc = StarDesktop.loadComponentFromURL( "private:factory/swriter", "_blank", 0, Array() )
  With oDoc
    .CurrentController.insertTransferable(v)
    .storeToUrl(ConvertToUrl(FileName), Array())
    .close(True)
  End With 
End Sub


Пример использования:

' Копирует диапазон A1:C3 активного листа в файл "C:\temp\test.odt"
Sub TestSelectionToODT()
 With ThisComponent.CurrentController
    .Select(.ActiveSheet.getCellRangeByName("A1:C3"))
 End With  
 SelectionToODT("C:\temp\test.odt")
End Sub
Владимир.

DimS

Простой и работающий код. Но, к сожалению, не переносит формат оригинала...

sokol92

Должен переносить и формат. Приведите, пожалуйста, пример файла Calc.
Владимир.

DimS


DimS


sokol92

Результат такой же, как и при переносе через буфер обмена.
Владимир.

economist

Если вам нужно "отражение 1:1" ODS в ODT - поможет в ODT Вставка - Объект  OLE - из Файла - Связать (если нужно чтобы обновлялось автоматом).

Если нужны обновления без окна запроса - нужно добавить путь в Доверенные источники.  
Руб. за сто, что Питоньяк
Любит водку и коньяк!
Потому что мне, без оных, -
Не понять его никак...

DimS

#8
На выходе должен быть файл Odt или Ods (не принципиально), с форматированием как у источника, но без формул и макросов. Файлы готовятся для дальнейшей рассылки.

bigor

Поддержать разработчиков LibreOffice можно можно тут, а наш форум вот тут

DimS

макрос экспорта в PDF прост, работает сказочно, но не подходит

bigor

Кстати макрос sokol92 если переносить не в odt, а в ods документ переносит почти все, кроме ширины ячеек. Это уже можно кодом затем подправить.
Поддержать разработчиков LibreOffice можно можно тут, а наш форум вот тут

sokol92

То, что можно сохранять в формате ODS - новация для этой темы. Тогда попробуем через буфер обмена (можно указывать различные опции для копирования).

' Сохраняет диапазон oRange документа oDoc как файл filename формата Calc
' flags - опции копирования: S тексты; V числа; D даты и время; F формулы; N комментарии; T форматы
'         по умолчанию: SVDT
Sub RangeToODS(Byval oDoc, Byval oRange, ByVal filename, Optional ByVal flags)
  Dim dispatcher, document, oDoc2
  If IsMissing(flags) Then
    flags="SVDT"
  End If 
 
  dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
 
  With oDoc.CurrentController
    .setActiveSheet(oRange.SpreadSheet)
    .select(oRange)
    dispatcher.executeDispatch(.frame, ".uno:Copy", "", 0, Array()) ' копируем выделенный диапазон в буфер обмена
  End With
 
  oDoc2 = StarDesktop.loadComponentFromURL( "private:factory/scalc", "_blank", 0, Array() ) 
  With oDoc2 
    .LockControllers
    dim args(5) as new com.sun.star.beans.PropertyValue
    args(0).Name = "Flags"          : args(0).Value = flags
    args(1).Name = "FormulaCommand" : args(1).Value = 0
    args(2).Name = "SkipEmptyCells" : args(2).Value = false
    args(3).Name = "Transpose"      : args(3).Value = false
    args(4).Name = "AsLink"         : args(4).Value = false
    args(5).Name = "MoveMode"       : args(5).Value = 4
    dispatcher.executeDispatch(.CurrentController.frame, ".uno:InsertContents", "", 0, args)
 
    CopyColumnWidth(oRange, .sheets(0).getCellRangeByName("A1"))
    .UnLockControllers   
   
    If filename<>"" Then
      .storeToUrl(ConvertToUrl(FileName), Array())
      .close(True)
    End If 
  End With   
End Sub

' Копирует ширины столбцов из диапазона oRange1 в oRange2
Sub CopyColumnWidth(oRange1, oRange2)
  Dim c1, n1 As Long, sheet2, columns2, j2 as Long
 
  columns2=oRange2.Spreadsheet.getColumns()
  j2=oRange2.getRangeAddress().StartColumn
   
  For Each c1 In oRange1.getColumns()
    n1=c1.Width
    If columns2(j2).width<>n1 Then
      columns2(j2).width=n1
    End If 
    j2=j2+1 
  Next c1
End Sub

' Копирует диапазон A1:F8 первого листа в файл "C:\temp\test.ods"
Sub TestRangeToODS
  RangeToODS(ThisComponent, ThisComponent.Sheets(0).getCellRangeByName("A1:F8"), "C:\temp\test.ods")
End Sub

Владимир.

DimS

sokol92. Владимир, Очень интересно. Работает как надо, спасибо! Теперь попробую всунуть его в свою кашу ... ;D