Macro for creating footnotes
I have been working on compiling a Personal book bible for Logos, one which is not available in Logos. What I have done is to create a text parser that turns the bible into HTML with Logos milestones and fields. I have marked off footnotes with {{field-on:footnote}} and cross references with {{field-on:crossref}}. I then open the HTML file in Word and save it as DOCX before compiling it in the Personal book builder.
I have tested, but Logos unfortunately does not turn them into footnotes automatically, and I cannot do this in HTML. Instead, it has to be done in a Word macro. I found a macro online which I have adapted for the purpose. Hopefully this can be of use for someone.
I decided to remove the field codes once the footnotes had been created. This can be changed by commenting out the Replace commands (i.e adding an apostrophe ' before any line beginning with strText = Replace).
Footnotes are marked with an asterisk * and cross references with a cross †
Sub Footnotes()
Dim oRng As Range
Dim strText As String
Set oRng = ActiveDocument.Range
With oRng.Find
Do While .Execute(FindText:="\{\{field-on:footnote\}\}*\{\{field-off:footnote\}\}", _
MatchWildcards:=True)
strText = oRng.Text
strText = Replace(strText, "{{field-on:footnote}}", "")
strText = Replace(strText, "{{field-off:footnote}}", "")
oRng.Text = ""
ActiveDocument.Footnotes.Add oRng, "*", strText
oRng.Collapse 0
Loop
End With
Set oRng = ActiveDocument.Range
With oRng.Find
Do While .Execute(FindText:="\{\{field-on:crossref\}\}*\{\{field-off:crossref\}\}", _
MatchWildcards:=True)
strText = oRng.Text
strText = Replace(strText, "{{field-on:crossref}}", "")
strText = Replace(strText, "{{field-off:crossref}}", "")
oRng.Text = ""
ActiveDocument.Footnotes.Add oRng, "†", strText
oRng.Collapse 0
Loop
End With
lbl_Exit:
Set oRng = Nothing
Exit Sub
End Sub