重复Microsoft Word VBA,直到找不到搜索结果

时间:2012-11-20 02:24:51

标签: vba ms-word word-vba

我创建了一个MS Word宏,用于搜索特定文本(由标记代码表示),剪切文本并将其插入新脚注,然后从脚注中删除标记代码。现在我希望宏重复,直到它在文本中找不到更多的标记代码 这是下面的宏

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

3 个答案:

答案 0 :(得分:12)

这个问题很好,您可以使用Selection.Find.Found结果遍历整个文档。

您所做的就是开始搜索,如果您发现结果只在Selection.Find.Found结果为真时进入循环。一旦你完成了这些,你就完成了。以下代码应该很适合你。

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

答案 1 :(得分:1)

可以不使用Do while(很多额外的行,并且浪费空间/时间)来完成此操作,它可以很简单,如下所示:

Sub SearchFN()

    'Start from The Top
    Selection.HomeKey Unit:=wdStory

    'Find the first search to start the loop
    Do
    With Selection.Find
        .ClearFormatting
        .Replacement.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 found the result then loop started
    If Selection.Find.Found Then

            '' Do your work here
            ' Always end your work after the first found result
            ' else it will be endless loop

    Else
    'If we do not found any then it will exit the loop
    Exit Do
    End If
    Loop

End Sub

答案 2 :(得分:0)

最简单的方法是使函数递归(函数调用自身)。将此行添加到您的子函数或函数的底部:

If (Selection.Find.Found = True) then call SearchFN