Welcome toVigges Developer Community-Open, Learning,Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
435 views
in Technique[技术] by (71.8m points)

Repeating Microsoft Word VBA until no search results found

I've created a MS Word macro that searches for certain text (indicated by markup codes), cuts the text and inserts it into a new footnote, and then deletes the markup codes from the footnote. Now I want the macro to repeat until it doesn't find any more markup codes in the text.
Here's the macro below

Sub SearchFN()

'find a footnote
Selection.Find.ClearFormatting
With Selection.Find
    .Text = "&&FB:*&&FE"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindContinue
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchKashida = False
    .MatchDiacritics = False
    .MatchAlefHamza = False
    .MatchControl = False
    .MatchByte = False
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchFuzzy = False
    .MatchWildcards = True
End With
Selection.Find.Execute

'cut the footnote from the text
Selection.Cut

'create a proper Word footnote
With Selection
    With .FootnoteOptions
        .Location = wdBottomOfPage
        .NumberingRule = wdRestartContinuous
        .StartingNumber = 1
        .NumberStyle = wdNoteNumberStyleArabic
    End With
    .Footnotes.Add Range:=Selection.Range, Reference:=""
End With

'now paste the text into the footnote
Selection.Paste

'go to the beginning of the newly created footnote
'and find/delete the code for the start of the note (&&FB:)
    Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
    .Text = "&&FB:"
    .Replacement.Text = ""
    .Forward = False
    .Wrap = wdFindContinue
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchKashida = False
    .MatchDiacritics = False
    .MatchAlefHamza = False
    .MatchControl = False
    .MatchByte = False
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchFuzzy = False
    .MatchWildcards = True
End With
Selection.Find.Execute
With Selection
    If .Find.Forward = True Then
        .Collapse Direction:=wdCollapseStart
    Else
        .Collapse Direction:=wdCollapseEnd
    End If
    .Find.Execute Replace:=wdReplaceOne
    If .Find.Forward = True Then
        .Collapse Direction:=wdCollapseEnd
    Else
        .Collapse Direction:=wdCollapseStart
    End If
    .Find.Execute
End With

'do same for ending code (&&FE)
With Selection.Find
    .Text = "&&FE"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindContinue
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchKashida = False
    .MatchDiacritics = False
    .MatchAlefHamza = False
    .MatchControl = False
    .MatchByte = False
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchFuzzy = False
    .MatchWildcards = True
End With
Selection.Find.Execute
With Selection
    If .Find.Forward = True Then
        .Collapse Direction:=wdCollapseStart
    Else
        .Collapse Direction:=wdCollapseEnd
    End If
    .Find.Execute Replace:=wdReplaceOne
    If .Find.Forward = True Then
        .Collapse Direction:=wdCollapseEnd
    Else
        .Collapse Direction:=wdCollapseStart
    End If
    .Find.Execute
End With

Selection.HomeKey Unit:=wdStory
'now repeat--but how??    

End Sub
See Question&Answers more detail:os

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Answer

0 votes
by (71.8m points)

Good question this one, you can loop through the whole document using the Selection.Find.Found result.

What you do is start a search and if you find a result go into a loop only while the Selection.Find.Found result is true. Once you've got through these, you're done. The following code should do the trick nicely for you.

Sub SearchFN()
    Dim iCount As Integer

    'Always start at the top of the document
    Selection.HomeKey Unit:=wdStory

    'find a footnote to kick it off
    With Selection.Find
        .ClearFormatting
        .Text = "&&FB:*&&FE"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchFuzzy = False
        .MatchWildcards = True
        .Execute
    End With

    'If we find one then we can set off a loop to keep checking
    'I always put a counter in to avoid endless loops for one reason or another
    Do While Selection.Find.Found = True And iCount < 1000
        iCount = iCount + 1

        'Jump back to the start of the document.  Since you remove the
        'footnote place holder this won't pick up old results
        Selection.HomeKey Unit:=wdStory
        Selection.Find.Execute

        'On the last loop you'll not find a result so check here
        If Selection.Find.Found Then

            ''==================================
            '' Do your footnote magic here
            ''==================================

            'Reset the find parameters
            With Selection.Find
                .ClearFormatting
                .Text = "&&FB:*&&FE"
                .Replacement.Text = ""
                .Forward = True
                .Wrap = wdFindContinue
                .Format = False
                .MatchCase = False
                .MatchWholeWord = False
                .MatchKashida = False
                .MatchDiacritics = False
                .MatchAlefHamza = False
                .MatchControl = False
                .MatchByte = False
                .MatchAllWordForms = False
                .MatchSoundsLike = False
                .MatchFuzzy = False
                .MatchWildcards = True
            End With
        End If
    Loop
End Sub

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome to Vigges Developer Community for programmer and developer-Open, Learning and Share
...