Productivity Sauce

While the markup macro described in the previous post does the trick of formatting Writer documents, it has one tiny drawback: it doesn't save the formatted text in a separate file, which can come in handy in many situations. So here is an updated version of the macro that formats the currently opened Writer document and saves it as a plain text file in the same directory.

 Sub HTMLMarkup

Dim Args(0) As New com.sun.star.beans.PropertyValue
ThisDoc=ThisComponent

MarkupHeadingsFunc("Heading 1", "<H1>", "</H1>")
MarkupHeadingsFunc("Heading 2", "<H2>", "</H2>")
MarkupHeadingsFunc("Heading 3", "<H3>", "</H3>")

MarkupTextFunc("CharWeight", com.sun.star.awt.FontWeight.BOLD, "<B>&</B>")
MarkupTextFunc("CharPosture", com.sun.star.awt.FontSlant.ITALIC, "<I>&</I>")

MarkupURLFunc

If (Not GlobalScope.BasicLibraries.isLibraryLoaded("Tools")) Then
GlobalScope.BasicLibraries.LoadLibrary("Tools")
End If

DocURL=ThisDoc.getURL()
DocDir=DirectoryNameoutofPath(DocURL, "/")
FileName=Left(Dir(DocURL, 0), Len(Dir(DocURL, 0))-4)

Args(0).Name="FilterName"
Args(0).Value="Text"
TextFilePath=ConvertToURL(DocDir & "/" & FileName & ".txt")
ThisDoc.StoreToURL(TextFilePath, Args())

End Sub

Function MarkupHeadingsFunc (StyleName, StartTag, EndTag)
ThisDoc=ThisComponent
ThisText=ThisDoc.Text
ParaEnum=ThisText.createEnumeration
While ParaEnum.hasmoreElements
 Para=ParaEnum.nextElement
  PortionEnum=Para.createEnumeration
   While PortionEnum.hasMoreElements
    Portion=PortionEnum.nextElement
     If Portion.paraStyleName = StyleName then
       Portion.String = StartTag + Portion.String + EndTag
      End if
   Wend
Wend
End Function

Function MarkupTextFunc(SearchAttrName, SearchAttrValue, ReplaceStr)
Dim SearchAttributes(0) As New com.sun.star.beans.PropertyValue
ThisDoc=ThisComponent
SearchAttributes(0).Name=SearchAttrName
SearchAttributes(0).Value=SearchAttrValue
ReplaceObj=ThisDoc.createReplaceDescriptor
ReplaceObj.SearchRegularExpression=true
ReplaceObj.searchStyles=false
ReplaceObj.searchAll=true
ReplaceObj.SetSearchAttributes(SearchAttributes)
ReplaceObj.SearchString=".*"
ReplaceObj.ReplaceString=ReplaceStr
ThisDoc.replaceAll(ReplaceObj)
End Function

Sub MarkupURLFunc
ThisDoc=ThisComponent
ThisText=ThisDoc.Text
ParaEnum=ThisText.createEnumeration
While ParaEnum.hasmoreElements
 Para=ParaEnum.nextElement
  PortionEnum=Para.createEnumeration
   While PortionEnum.hasMoreElements
    Portion=PortionEnum.nextElement
     If Portion.HyperlinkURL <> "" then
       Portion.String = "<A HREF=""" + Portion.HyperlinkURL +""">" +Portion.String + "</A>"
      End if
   Wend
Wend
End Sub