Ask Your Question

Revision history [back]

A LibreOffice Basic macro to wrap selected text in Web markup.
by Hank Davis, Seattle WA

While serving as the Technical Editor of Seattle's nonprofit Victory Review 
(www.victorymusic.org), I ported a number of my MS Word VBA Web authoring macros 
over to OpenOffice, and from there to LibreOffice. Here is one, with procedures 
for using it and embedded remarks. Critiques and improvements from the 
open source community are welcome. 

For example, you might want to define your own base class for paragraph elements, 
rather than use Microsoft's "MsoNormal" class. And most large sites rely on global 
CSS stylesheets, rather than use inline styles. So rather than take this listing as 
gospel, think of it as a little "demonstration of concept" to build upon and modify
as you like.

I. Enable the LibreOffice Advanced and Macro Security Options.
    A. On the Tools menu, select Options. 
    B. In the Options dialog, under the LibreOffice node, choose Advanced 
         and select the checkboxes for these options:
             Enable experimental features 
             Enable macro recording 
    C. Choose the LibreOffice Security options, click the Macro Security button, 
         and set your Security Level to Medium.
    D. [Optional -- If you are working on a home computer that is secure] 
         On the Trusted Sources tab of Macro Security, add your 
         ...\ Application Data \ LibreOffice \ 4 \ user \ template folder 
         as a Trusted File Location, and store your .bas files 
         of Basic macros there, along with the templates that use them.

II. Add the macro and functions that follow to your document.
    A. Create a LibreOffice Writer document, and save it to your hard drive.
    B. From the Tools menu, select Macros > Organize Macros > Libre Office Basic.
    C. Expand the Object Catalog in the left pane, select the node for  
         your document, and click New.
    D. Name your new macro module, and click OK.
    E. Click Edit. Your module should be selected in 
         the Object Catalog pane on the left. 
    F. In the code pane on the right, paste in the subroutine 
         and functions that follow.
    G. Compile and Save, then Close the Basic dialog and return to your doc.

III. Try out this macro.
    A. Type a few dummy lines into your doc, using blank lines 
         for paragraph breaks. For example:

First paragraph.
Second paragraph.

Third paragraph.
Fourth paragraph.

    B. Select the lines that you typed. 
    C. From the Tools menu, select Macros > Run Macro. 
    D. In the "Library" pane, expand the node for your doc and select 
         the macro node that you've named. 
    E. In the "Macro name" pane, select this "Ins_par_hd()" macro 
         and click the Run button.
    F. Enter a choice of font color and style (as an integer from 1 to 5), 
         and click OK. The sentences selected will be wrapped in Web markup.

Enjoy.  -- Hank

Sub Ins_par_hd()
    ' REM  Written by Hank Davis, while Technical Editor of 
    '   Seattle's nonprofit Victory Review.
    ' REM  Inserts Web markup around selected paragraphs of text. 

    ' REM  Fans of acoustic music might enjoy the articles listed 
    '   on Hank's VR Author's page: 
    ' http://www.victorymusic.org/index.php?
    ' option=com_content&view=article&id=1247&catid=151&sectionid=18 

    Dim sMsg As String
    sMsg = "Macro canceled."
    On Error GoTo Leave

    ' REM  The MS Word VBA method Selection.Text won't work in LibreOffice Writer:
    ' sSel = Selection.Text

    '  REM  So do this instead:
    Dim oCtrl as Object
    oCtrl = ThisComponent.CurrentController
    Dim oVC as Object
    oVC = oCtrl.getViewCursor()
    Dim sSel As String
    sSel = oVC.getString()

    ' REM  Set values for sSel and StartedEmpty. 
    Dim StartedEmpty As Boolean    
    If sSel = "" or sSel = Null Then
        StartedEmpty = True
        sSel = ""
    Else
        StartedEmpty = False
    End If

    ' REM  Define string variables:
    Dim sSP As String
    sSP = Chr(32)
    Dim sTab As String
    sTab = sSP & sSP & sSP
    Dim sEN As String
    sEN = Chr(13)
    Dim sLF As String
    sLF = Chr(10)
    Dim sCR As String
    sCR = sEN & sLF
    Dim sQ2 As String
    sQ2 = Chr(34)

    ' REM  Display an InputBox with choices of text color and paragraph style:
    sMsg = sTab & "1 - navy" & sTab & sTab & "2 - navy italic" 
    sMsg = sMsg & sLF & sTab & "3 - brown" & sTab & "4 - brown italic" 
    sMsg = sMsg & sLF & sTab & "5 - plain" 

    Dim sHue As String
    sHue = "1"
    sHue = InputBox(sMsg, "Insert snippet", sHue)

    If sHue = "" Then 
        sMsg = "Macro canceled."
        GoTo Leave
    End If
    Dim iHue As Integer
    iHue = CInt(sHue)
    If iHue < 1 Or iHue > 5 Then 
        sMsg = "Invalid choice. Macro canceled."
        GoTo Leave
    End If

    ' REM  Convert sHue choice to color & style values for Web markup.
    Select Case sHue
        Case "1"
            sHue = "000044"
        Case "2"
            sHue = "000044; font-style: italic"
        Case "3"
            sHue = "480000"
        Case "4"
            sHue = "480000; font-style: italic"
        Case "5"
            sHue = ""
        Case Else
            sHue = "000044"
    End Select

    Dim sSnipa As String
    sSnipa = ""
    Dim sSnipb As String    
    sSnipb = ""

    If StartedEmpty Then
        ' REM  Construct HTML markup to insert.
        sSel = ""
        Select Case iHue
            Case "1","2","3","4"
                sSnipa = "<p class=" & sQ2 & "MsoNormal" & sQ2 
                sSnipa = sSnipa & " style=" & sQ2 
                sSnipa = sSnipa & "font-family: Arial, Tahoma, sans-serif;"
                sSnipa = sSnipa & " color: #" & sHue & ";" & sQ2 & ">"
                sSnipb = "</p>" & sEN
            Case 5 
                sSnipa = "<p>" 
                sSnipb = "</p>" & sEN
            Case Else
                sSnipa = "<p>" 
                sSnipb = "</p>" & sEN
        End Select

    Else
        ' REM  Wrap selection in HTML markup.
        Dim sSelb As String
        Dim bLoop As Boolean
        bLoop = True
        Dim iCount As Integer
        iCount = 0
        Dim iCut As Long
        Dim iCutb As Long

        Do While bLoop
            iCount = iCount + 1
            If iCount > 40 Then
                sMsg = "Selection is too big." 
                bLoop = False
                GoTo Leave
            End If

            'Trim any sCR or sSP from start or end of selection. 
            If (Len(sSel) > 3) Then
                ' REM  (The cropsel() function follows this subroutine.)
                sSel = cropsel(sSel)
            End If            

            ' REM  Look for the next empty line in sSel
            iCut = InStr(1, sSel, sCR & sCR, 1)
            Select Case iCut
                Case < 1
                    ' REM  msgbox "No more empty lines in sSel, so exit bLoop."
                    sSelb = sSel
                    bLoop = False
                Case Len(sSel)-4
                    ' REM  msgbox "Empty line at end of sSel, so exit bLoop."
                    sSelb = Left(sSel, iCut - 1)
                    bLoop = False
                Case > 0
                    ' REM  msgbox "Empty line within sSel, so cut sSel there."
                    sSelb = Left(sSel, iCut - 1)
                    sSel = Mid(sSel, iCut + 4)
                Case Else
                    ' REM  msgbox "Case: Else, so exit bLoop."
                    sSelb = ""
                    bLoop = False
            End Select

            If iCount > 1 Then
                sSnipa = sSnipa & sEN 
            End If

            Select Case iHue
                Case "1","2","3","4"
                    sSnipa = sSnipa & "<p class=" & sQ2 & "MsoNormal" & sQ2 
                    sSnipa = sSnipa & " style=" & sQ2 
                    sSnipa = sSnipa & "font-family: Arial, Tahoma, sans-serif;"
                    sSnipa = sSnipa & " color: #" & sHue & ";" & sQ2 & ">"
                    sSnipb = "</p>" & sEN
                Case 5 
                    sSnipa = sSnipa & "<p>" 
                Case Else   
                    sSnipa = sSnipa & "<p>" 
            End Select

            iCut = Len(sSelb)-4
            iCut = InStr(iCut, sSelb, sCR, 1)
            If (iCut > 0) Then
                ' REM  msgbox "sCR at end of selection."
                sSelb = Left(sSelb, iCut-2)
            End If
            ' REM  Add markup for mid-paragraph line breaks
            sSelb = Replace(sSelb, sCR, sEN & "<br>")

            If (Not bLoop) or (iCount > 40) or (sSel = sCR) or (sSel = "") Then
                bLoop = False
                sSnipa = sSnipa & sSelb 
                sSnipb = "</p>"
            Else
                    sSnipa = sSnipa & sSelb & "</p>" & sEN
            End If       
        Loop
    End If

    ' REM  The MS Word VBA Selection object and its methods 
    '      won't work in LibreOffice:
    ' With Selection
    '    .TypeText Text:=sSnipa
    '    .InsertAfter Text:=sSnipb
    '    .MoveLeft Unit:=wdCharacter, Count:=12
    ' End With

    ' REM  So do this instead:
    ' REM  Insert sSnipa before selection.
    oVC.getText.insertString(oVC.getStart(), sSnipa, False)

    ' REM  Replace selection with sSnipb (which includes it).
    oVC.setString(sSnipb)

    ' REM  Position cursor after sSnipa.
    oVC = oCtrl.getViewCursor()

    ' REM  Deselect sSnipb (The desel() function follows this subroutine.)
    desel oVC   

    GoTo Done
Leave:
    MsgBox sMsg, MB_OK, "Cancel macro"
Done:
End Sub

Function cropsel(sCrop) as String
    'Written by Hank Davis
    Dim sEN As String
    sEN = Chr(13)
    Dim sLF As String
    sLF = Chr(10)
    Dim sCR As String
    sCR = sEN & sLF
    Dim sTrim as String

    ' REM  If sCrop starts with an sCR or a space, trim them.
    If (Len(sCrop) > 3) Then
        If (InStr(1, sCrop, sCR, 1) = 1) Then
            sCrop = Mid(sCrop, 3)
        End If 
        sTrim = Mid(sCrop, 1, 1)
        If (sTrim = " ") Then
            sTrim = Mid(sTrim, 2)
        End If 

        ' If sCrop ends with an sCR or a space, trim them.
        If (InStr(Len(sCrop)-1, sCrop, sCR, 1) = Len(sCrop)-1) Then
            sCrop = Mid(sCrop, 1, Len(sCrop) - 2)
        End If
        sTrim = Mid(sCrop, Len(sCrop), 1)
        If sTrim = " " Then
           sCrop = Mid(sCrop, 1, Len(sCrop) - 1)
        End If
    End If

    If (Len(sCrop) < 3) Then
        sCrop = ""
    End If

    cropsel = sCrop
End Function

Sub desel(oVC)
    'Written by Hank Davis
    Dim oTxtCur as Object
    oTxtCur = ThisComponent.Text.createTextCursorByRange(oVC)
    oTxtCur.collapseToStart()
    oVC.gotoRange(oTxtCur, False)
End Sub