1
votes

Thanks in advance for taking the time to read this.

I would like to code the Find function in Word 2013 for searching specific words in multiple styles. Not even sure if this is possible because Word doesn't have that option in Advanced Find --> More --> Format --> Style. It only allows for filtering one style.

My goal is to be able to find paragraph marks (syntax: ^p) on styles 'Heading 1' through 'Heading 9'.

Sub AppendixFix()

    ' Declaring variables
    Dim multiStyles As String, i As Integer
    multiStyles = "Heading 1, Heading 2, Heading 3, Heading 4, Heading 5, Heading 6, Heading 7, Heading 8, Heading 9"

    ' Start at the top of document and clear find formatting
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting

    ' Navigate to Appendix section
    Selection.Find.Style = ActiveDocument.Styles("Heading 1")
    With Selection.Find
        .Text = "Appendix"
        .Forward = True
        .Wrap = wdFindAsk
        .Format = True
        .Execute
    End With

    ' Loop until find is not found and limit to 1000 counts
    Do While Selection.Find.Found = True And i < 1000
        i = i + 1
        ' Add text to the beginning of each line
        Selection.HomeKey Unit:=wdLine
        Selection.TypeText Text:=" *Test* "
        ' Navigate to the next heading by looking at following paragraph mark
        Selection.Find.Style = ActiveDocument.Styles(multiStyles)
        With Selection.Find
            .Text = "^p"
            .Forward = True
            .Wrap = wdFindStop
            .Format = True
            .Execute
            .Execute
        End With
    Loop

End Sub

I expected the code to start inputting Test at the first 'Appendix' heading, then inputs Test to its sub-headings (Heading 2, 3..., 9), and continues to the end of the document. However, it only adds the text to Heading 1-styled headers skipping its sub-headers. It seems to me that only the first style in the list gets read in. I've tried removing Heading 1 from the list and it checks for Heading 2-styled headers.

2
I think the better option here is to search ALL text, and test against the .Style property of the selected text. You could say If InStr(multiStyles, Selection.Style) Then to test the True condition.dwirony
Sorry, I'm not familiar with that function. Where would I place it in my code? Also, I would like to only modify the headings from Appendix and below so I don't think I should search ALL texts.ItsTnTg
Ah I see what you're trying to do now - did you get this code from somewhere else? What your trying to do won't work, you need to iterate through an array. I'll try to fix it up now.dwirony
I tried putting in the InStr code before the Do While loop but nothing happened. It's my own code that I pieced together from different ideas. The end goal is actually to delete the first 2 or 3 characters of each header instead of inserting Test. I'll also need to figure out how to identify the first 2 characters of each header as numbers before deleting them.ItsTnTg

2 Answers

1
votes

The following worked for me in a test document based on what I understand the set up of the document in the question is.

The code needs to loop the styles. In order to do this, the styles need to be in something that can be looped - an array. The Split method splits up a list into an array, based on a delimiter. The delimiter can be only one character, so the spaces after the commas need to be removed from multiStyles in the code in the question.

When looping, it's important to return to the starting point (Appendix) for each style. For that, the code below uses a Range object.

The "Test" text should only be added if something is found. The code below uses a boolean variable to store what Find.Execute returns (true if found) so that this as well as the Loop Until can be tested reliably.

It's possible that a Find can end up at the end of the document. In that case, the code goes into an endless loop, so there's a test for the end position to move to the next style in the list.

Sub AppendixFix()

    ' Declaring variables
    Dim multiStyles As String, i As Integer
    Dim aStyleList As Variant
    Dim counter As Long, s As String, found As Boolean
    Dim rngStart As Range

    multiStyles = "Heading 1,Heading 2,Heading 3,Heading 4,Heading 5,Heading 6,Heading 7,Heading 8,Heading 9"
    aStyleList = Split(multiStyles, ",")

    ' Start at the top of document and clear find formatting
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting

    ' Navigate to Appendix section
    Selection.Find.style = ActiveDocument.styles("Heading 1")
    With Selection.Find
        .Text = "Appendix"
        .Forward = True
        .wrap = wdFindStop
        .Format = True
        .Execute
    End With
    Selection.HomeKey Unit:=wdLine
    Selection.TypeText Text:=" *Test* "
    Selection.MoveStart wdParagraph, 1
    Set rngStart = Selection.Range.Duplicate

    ' Loop through all the styles in the list
    For counter = LBound(aStyleList) To UBound(aStyleList)
        'Loop as long as the style is found
        Do
            s = aStyleList(counter)
            With Selection.Find
                .style = ActiveDocument.styles(s)
                .Text = "^p"
                .Forward = True
                .wrap = wdFindStop
                .Format = True
                found = .Execute
            End With

            ' Add text to the beginning of each line
            If found Then
                Selection.HomeKey Unit:=wdLine
                Selection.TypeText Text:=" *Test* "
                Selection.MoveStart wdParagraph, 1
            End If
            If Selection.Start = ActiveDocument.content.End - 1 Then
                'End of Document, then loop to next style in list
                Exit For
            End If
        Loop Until found = False
        'start back at the Appendix for the next style
        rngStart.Select
    Next
End Sub
0
votes

Give this a shot - this will add test to the end of each of your headers, I believe. It's hard to tell what you're trying to do from your question.

Sub AppendixFix()

    ' Declaring variables
    Dim multiStyles As Variant, i As Integer
    multiStyles = Array("Heading 1", "Heading 2", "Heading 3", "Heading 4", "Heading 5", "Heading 6", "Heading 7", "Heading 8", "Heading 9")

    ' Start at the top of document and clear find formatting
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting

    ' Navigate to Appendix section
    Selection.Find.Style = ActiveDocument.Styles("Heading 1")
    With Selection.Find
        .Text = "Appendix"
        .Forward = True
        .Wrap = wdFindAsk
        .Format = True
        .Execute
    End With

    ' Loop until find is not found and limit to 1000 counts
    Do While Selection.Find.Found = True And i < 1000
        i = i + 1
        ' Add text to the beginning of each line
        Selection.HomeKey Unit:=wdLine
        Selection.TypeText Text:=" *Test* "
        ' Navigate to the next heading by looking at following paragraph mark
        For j = 0 To UBound(multiStyles)
            Selection.Find.Style = ActiveDocument.Styles(multiStyles(j))
            With Selection.Find
                .Text = "^p"
                .Forward = True
                .Wrap = wdFindStop
                .Format = True
                .Execute
                .Execute
            End With
            Selection.TypeText Text:=" *Test* "
        Next j
    Loop

End Sub