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§ionid=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
