Microsoft Word macro to alter heading styles - vba

Question

I am attempting to create a macro in Word that alters the style of a set of ~150 unique headings. All styles must be identical. My current code works and changes the formatting correctly, but only one heading at a time.
Simply put, it's ugly.
I'm looking for something I can reuse, and possibly apply to more projects in the future.
Maybe using the loop command? I don't know, I'm still somewhat new using VBA.
Sub QOS_Headings()
Dim objDoc As Document
Dim head1 As Style, head2 As Style, head3 As Style, head4 As Style
Set objDoc = ActiveDocument
Set head1 = ActiveDocument.Styles("Heading 1")
Set head2 = ActiveDocument.Styles("Heading 2")
With objDoc.Content.Find
.ClearFormatting
.Text = "Section A.^p"
With .Replacement
.ClearFormatting
.Style = head1
End With
.Execute Wrap:=wdFindContinue, Format:=True, Replace:=wdReplaceOne
End With
End With
End Sub

Answer 1

If there is no way in which you can identify the heads you want automatically you may have to write everything once. Create a separate function for this purpose. It might look like this:-
Private Function SearchCriteria() As String()
Dim Fun(6) As String ' Fun = Designated Function return value
' The number of elements in the Dim statement must be equal to
' the number of elements actually declared:
' observe that the actual number of elements is one greater
' than the index because the latter starts at 0
Fun(0) = "Text 1"
Fun(1) = "Text 2"
Fun(2) = "Text 3"
Fun(3) = "Text 4"
Fun(4) = "Text 5"
Fun(5) = "Text 6"
Fun(6) = "Text 7"
SearchCriteria = Fun
End Function
You can add as many elements as you wish. In theory it is enough if they are unique within the document. I shall add some practical concerns below. Use the code below to test the above function.
Private Sub TestSearchCriteria()
Dim Crits() As String
Dim i As Long
Crits = SearchCriteria
For i = 0 To UBound(Crits)
' prints to the Immediate Window:
' select from View tab or press Ctl+G
Debug.Print Crits(i)
Next i
End Sub
Now you are ready to try to actually work on your document. Here is the code. It will not effect any changes. It's just the infrastructure for testing and getting ready.
Sub ChangeTextFormat()
Dim Crits() As String
Dim Rng As Range
Dim Fnd As Boolean
Dim i As Long
Crits = SearchCriteria
For i = 0 To UBound(Crits)
' find the Text in the document
Set Rng = ActiveDocument.Content
With Rng.Find
.ClearFormatting
.Execute FindText:=Crits(i), Forward:=True, _
Format:=False, Wrap:=wdFindStop
Fnd = .Found
End With
If Fnd = True Then
With Rng
Debug.Print .Text
' .MoveStart wdWord, -2
' With .Font
' .Italic = True
' .Bold = True
' End With
End With
Else
Debug.Print "Didn't find " & Crits(i)
End If
Next i
End Sub
The first half of the procedure will find each of the search criteria in your document using the same kind of loop as you already know from the test procedure. But now the text is fed to the Find method which assigns the found text to the Rng range. If the item is found you now have a handle on it by the name of Rng.
The second half of the sub deals with the outcome of the search. If the text was found the found text (that is Rng.Text) is printed to the Immediate window, otherwise the original text Crits(i) with "didn't find".
If the text was found you want to assign a style to it. But before you can do so you should deal with the difference between the text you found and the text you want to format. This difference could be physical, like you didn't write the entire length of the text in the criteria, or technical, like excluding paragraph marks. In my above sub there is just random code (extending the Rng by two preceding words and formatting everything as bold italics). Consider this code a placeholder.
For your purposes code like this might do the job, perhaps. .Paragraphs(1).Style = Head1 Actually, that is rather a different question, and I urge you not to rush for this result too fast. The part you now have needs thorough testing first.