Макрос Libreoffice Writer Изменить размер шрифта

Question

Этот вопрос был опубликован, чтобы помочь решить эту наградуAsk Ubuntu 350, которая заканчивается сегодня. Я бы предпочел, чтобы кто-нибудь из " Переполнения стека" опубликовал ответ и получил вознаграждение, а не увидел, что он остался без награды, а у ОП не было рабочего решения.

У меня есть этот макрос, собранный из трех источников (извините, довольно уродливо на данном этапе). Всего проект должен изменить все не 18 пунктов до 12 пунктов. Затем измените 18 пунктов на 22 пункта. Затем установите заголовок от 1 до 28 пунктов. Я часами пытался сделать эту простую вещь, записывая макросы, которые просто разочаровывают.

Вот записанный макрос на данный момент:

изменить 10 баллов до 12 баллов. Он работает без ошибок, но ничего не меняет:

Sub AllFonts
rem - change all font names to Ubuntu.
rem - If heading 1 set font size to 28
rem - else if font size is 18 set to 22
rem - else set font size to 12

rem The macro will save document and exit Libreoffice Writer.

Dim CharHeight As Long, oSel as Object, oTC as Object
Dim CharStyleName As String
Dim oParEnum as Object, oPar as Object, oSecEnum as Object, oSec as Object
Dim oVC as Object, oText As Object
Dim oParSection        'Current Section

oText = ThisComponent.Text
oSel = ThisComponent.CurrentSelection.getByIndex(0) 'get the current selection
oTC = oText.createTextCursorByRange(oSel)           ' and span it with a cursor

rem Scan the cursor range for chunks of given text size.
rem (Doesn't work - affects the whole document)

oParEnum = oTC.Text.createEnumeration()
Do While oParEnum.hasMoreElements()
  oPar = oParEnum.nextElement()
  If oPar.supportsService("com.sun.star.text.Paragraph") Then
    oSecEnum = oPar.createEnumeration()
    oParSection = oSecEnum.nextElement()
    Do While oSecEnum.hasMoreElements()
      oSec = oSecEnum.nextElement()
      If oSec.TextPortionType = "Text" Then
        CharStyleName = oParSection.CharStyleName
        CharHeight = oSec.CharHeight
        if CharStyleName = "Heading 1" Then
            oSec.CharHeight = 28
        elseif CharHeight = 18 Then
            oSec.CharHeight = 22
        else
            oSec.CharHeight = 12
        End If
      End If
    Loop
  End If

Loop

FileSave
stardesktop.terminate()

End Sub


Sub UbuntuFontName
rem ----------------------------------------------------------------------
rem define variables
dim document   as object
dim dispatcher as object
rem ----------------------------------------------------------------------
rem get access to the document
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

rem ----------- Select all text ------------------------------------------
dispatcher.executeDispatch(document, ".uno:SelectAll", "", 0, Array())

rem ----------- Change all fonts to Ubuntu -------------------------------
dim args5(4) as new com.sun.star.beans.PropertyValue
args5(0).Name = "CharFontName.StyleName"
args5(0).Value = ""
args5(1).Name = "CharFontName.Pitch"
args5(1).Value = 2
args5(2).Name = "CharFontName.CharSet"
args5(2).Value = -1
args5(3).Name = "CharFontName.Family"
args5(3).Value = 0
args5(4).Name = "CharFontName.FamilyName"
args5(4).Value = "Ubuntu"

dispatcher.executeDispatch(document, ".uno:CharFontName", "", 0, args5())

end sub


sub FileSave
rem ----------------------------------------------------------------------
rem define variables
dim document   as object
dim dispatcher as object
rem ----------------------------------------------------------------------
rem get access to the document
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

rem ----------------------------------------------------------------------
dispatcher.executeDispatch(document, ".uno:Save", "", 0, Array())


end sub

В конце вылетает это сообщение:

Answer 1

Вот исправленный код. Однако детали заголовка 1 не ясны. В приведенном ниже коде предполагается, что заголовки были использованы правильно, а стиль абзаца применяется к тексту без прямого форматирования.

Sub ChangeAllFonts
    rem - Change all font names to Ubuntu.
    rem - If heading 1 set font size to 28
    rem - else if font size is 18 set to 22
    rem - else set font size to 12
    rem - The macro will save document and exit LibreOffice Writer.
    Dim oDoc As Object
    Dim oParEnum As Object, oPar As Object, oSecEnum As Object, oSec As Object
    Dim oFamilies As Object, oParaStyles As Object, oStyle As Object
    oDoc = ThisComponent
    oParEnum = oDoc.Text.createEnumeration()
    Do While oParEnum.hasMoreElements()
      oPar = oParEnum.nextElement()
      If oPar.supportsService("com.sun.star.text.Paragraph") Then
        oSecEnum = oPar.createEnumeration()
        Do While oSecEnum.hasMoreElements()
          oSec = oSecEnum.nextElement()
          If oSec.TextPortionType = "Text" Then
            If oSec.ParaStyleName = "Heading 1" Then
                rem ignore for now
            ElseIf oSec.CharHeight = 18 Then
                oSec.CharHeight = 22.0
            Else
                oSec.CharHeight = 12.0
            End If
          End If
        Loop
      End If
    Loop
    oFamilies = oDoc.getStyleFamilies()
    oParaStyles = oFamilies.getByName("ParagraphStyles")
    oStyle = oParaStyles.getByName("Heading 1")
    oStyle.setPropertyValue("CharHeight", 28.0)
    FileSave
    StarDesktop.terminate()
End Sub

Завершение LibreOffice из макроса без сбоя, как известно, сложно. Для пакетной обработки лучше закрыть документ и оставить приложение LO открытым. Затем, когда все закончится, один из подходов - принудительно завершить процесс из сценария оболочки.

В Интернете много информации о других способах выхода из LO.