Libreoffice Writer Macro Change Font Size

Question

This question was posted to help solve this Ask Ubuntu 350 point bounty that ends today. I would rather someone in Stack Overflow post an answer and get the bounty than see it go unrewarded and the OP not getting a working solution.

I have this macro pieced together from three sources (sorry kind of ugly at this stage). The total project is to change everything not 18 pt to 12 pt. Then change 18 pt to 22 pt. Then set Heading 1 to 28 pt. I've spent hours trying to get this simple thing done by recording macros which just leaves one dissappointed.

Here is the recorded macro so far:

to change 10 point to 12 point. It runs without error but doesn't change a thing:

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

It crashes at end with this message:

The recorder is often not helpful. That's probably why it's an experimental feature. Searching the title in Google produces plenty of results, for example, https://forum.openoffice.org/en/forum/viewtopic.php?f=20&t=60896. If you get stuck, please post the API code (i.e. "normal basic," not recorded) you have so far. — Jim K, Apr 04 '18 at 19:51
@JimK I've read that link a couple of times but it didn't click that Character Height and Font Point Size were one and the same. Thanks for the clarification. I've had 8 hours over three days fighting the macro recorder which seemed to have worked fine years ago in Calc. — WinEunuuchs2Unix, Apr 04 '18 at 22:54
Agreed; the name "Character Height" is not what I expected when I first ran across it some years ago. It's one of those quirks about the API that you need to learn once, and from then on you'll know what to do. — Jim K, Apr 05 '18 at 18:09
@JimK I updated the macro with your suggested link, plus another link plus my own code. The Frankenstein isn't working though. Even without `.terminate` in the end the fonts aren't changing name or size. — WinEunuuchs2Unix, Apr 05 '18 at 23:19
This "Frankenstein" code is not even close to working, but it's good enough for me to develop into a working solution, which I have done in the answer below. — Jim K, Apr 06 '18 at 17:24

score 1 · Accepted Answer · answered Apr 06 '18 at 17:13

Here is the corrected code. However, the details about Heading 1 are not clear. The code below assumes that the headings have been used properly, with the paragraph style applied to text with no direct formatting.

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

Exiting LibreOffice from a macro without a crash is notoriously tricky. For batch processing, it's better to close the document and leave the LO application open. Then when it's all finished, one approach is to force kill the process from a shell script.

There is plenty of information online about other ways to exit LO gracefully.

Thank you very much. There are 100+ files to process. So after save operator can press `Alt`+`F4` to close LO and the `bash` script will call LOW with the next file in the list. I assume Heading 1 is a normal style sheet and everything else is Default Style with font overrides but OP did not stipulate. — WinEunuuchs2Unix, Apr 06 '18 at 17:44

Libreoffice Writer Macro Change Font Size

1 Answers1