parish

VB Code to Format Psalmody from the Church of England Website

While I have some time to work on things that feed my soul, I have been working on some code to take the pain out of formatting and reformatting the Psalms from the CofE Website. This is my workflow and how this Word Macro works…

  • Go to https://www.churchofengland.org/prayer-and-worship/join-us-service-daily-prayer
  • Under “More Options” select the date you want the Psalm(s) for and select “Apply”
  • Choose the Service you want, in this case “Morning Prayer (Contemporary) for <date>”
  • Scroll down and select the Psalm from the title to the end of the “Refrain” (which we call Antiphon)
  • Copy this text and go to a blank new document in word. Paste it in there (Ctrl-V)
  • Now run the Psalmody code as shown below.
  • It will format the text in a pleasing way with bold lines for the congregation to respond to and nice tabs. 
Sub Psalmody()

ActiveDocument.Range.Select
Selection.ParagraphFormat.LeftIndent = InchesToPoints(0)
Selection.Font.Name = "Gill Sans MT"

Call SR("Refrain:", "Antiphon:" & Chr(9))
Call SR(ChrW(&H2666), " *")

'embolden every other line
Dim totalPara As Integer
totalPara = ActiveDocument.Paragraphs.Count

' All Paras Colour Change
For Count = 1 To totalPara
    ActiveDocument.Paragraphs(Count).Range.Font.ColorIndex = wdAutomatic
Next

' All Paras tab text
Dim ParaString As String

For Count = 1 To totalPara

'find a para which begins with a number
ParaString = ActiveDocument.Paragraphs(Count).Range.Text
    If IsNumeric(Left(ParaString, 1)) Or IsNumeric(Left(ParaString, 1)) Then
    
        If IsNumeric(Left(ParaString, 1)) Then
            numPart = Left(ParaString, 1)
            textPart = Mid(ParaString, 2)
        End If
        If IsNumeric(Left(ParaString, 2)) Then
            numPart = Left(ParaString, 2)
            textPart = Mid(ParaString, 3)
        End If
        If IsNumeric(Left(ParaString, 3)) Then
            numPart = Left(ParaString, 3)
            textPart = Mid(ParaString, 4)
        End If
        
        newText = numPart & Chr(9) & textPart
        
        newText = Replace(newText, Chr(11), Chr(11) & Chr(9))
        
        ActiveDocument.Paragraphs(Count).Range.Text = newText
        
    
    End If

Next


For Count = 4 To totalPara Step 2

    ActiveDocument.Paragraphs(Count).Range.Bold = True

Next

End Sub

Sub SR(strFind As String, strReplace As String)

    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = strFind
        .Replacement.Text = strReplace
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

End Sub
By spr