Макрос вставки раздела.

Автор variator, 21 июля 2018, 20:50

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

variator

Добрый день!
Прошу помочь в создании макроса для вставки раздела в документ Writer.
Для чего нужно? Обширные статьи и мануалы не читаю из монитора, а перегоняю в бумажный вариант. При этом часто расположение текста в двух колонках экономит пространство.
Пробовал создать макрос с помощью "Запись макроса". Работает, но не сохраняется значение расстояния между колонками.
Вот в чем, собственно, и проблема.
P.S. Питоньяка читать намереваюсь. )


mikekaganski

Sub SelectionToSection()
  ' Thanks to:
  ' http://www.pitonyak.org/AndrewMacro.odt - 7.25.1 Insert a text section, setting columns and widths
  ' https://www.programcreek.com/java-api-examples/index.php?api=com.sun.star.text.XTextContent
  Dim oDoc As Object, oSel As Object
  oDoc = ThisComponent
  oSel = oDoc.getCurrentSelection()
  If (Not oSel.supportsService("com.sun.star.text.TextRanges")) Then
    Exit Sub ' We need a range; possibly an object selected - I don't handle that atm
  ElseIf (oSel.Count <> 1) Then
    Exit Sub ' a multi-selection is not supported
  End If
  Dim oRange As Object
  oRange = oSel(0)
  Dim oSect As Object, oCols As Object, aC()
  oSect = oDoc.CreateInstance("com.sun.star.text.TextSection")
  oCols = oDoc.CreateInstance("com.sun.star.text.TextColumns")
  oCols.setColumnCount(2)
  aC() = oCols.getColumns()
  aC(0).RightMargin = 500 ' 5 mm
  aC(1).LeftMargin = 500 ' 5 mm
  oCols.setColumns(aC())
  oSect.TextColumns = oCols
  oDoc.getText().insertTextContent(oRange, oSect, True)
End Sub
С уважением,
Михаил Каганский

variator

Цитата: mikekaganski от 22 июля 2018, 05:12
Sub SelectionToSection()
  ' Thanks to:
  ' http://www.pitonyak.org/AndrewMacro.odt - 7.25.1 Insert a text section, setting columns and widths
  ' https://www.programcreek.com/java-api-examples/index.php?api=com.sun.star.text.XTextContent
  Dim oDoc As Object, oSel As Object
  oDoc = ThisComponent
  oSel = oDoc.getCurrentSelection()
  If (Not oSel.supportsService("com.sun.star.text.TextRanges")) Then
    Exit Sub ' We need a range; possibly an object selected - I don't handle that atm
  ElseIf (oSel.Count <> 1) Then
    Exit Sub ' a multi-selection is not supported
  End If
  Dim oRange As Object
  oRange = oSel(0)
  Dim oSect As Object, oCols As Object, aC()
  oSect = oDoc.CreateInstance("com.sun.star.text.TextSection")
  oCols = oDoc.CreateInstance("com.sun.star.text.TextColumns")
  oCols.setColumnCount(2)
  aC() = oCols.getColumns()
  aC(0).RightMargin = 500 ' 5 mm
  aC(1).LeftMargin = 500 ' 5 mm
  oCols.setColumns(aC())
  oSect.TextColumns = oCols
  oDoc.getText().insertTextContent(oRange, oSect, True)
End Sub

Жить стало лучше, жить стало веселей.
Спасибо!