在 Word 文档中的特定单词之间搜索

Question

此宏通过 Word 文档搜索单词：Set r = WordDoc.Range。是否可以使其仅在 Word 文档中的特定单词之间进行搜索？示例：仅从“Word1”搜索到“Word2”。我知道我需要找到这些单词并将它们设置为 Range.Start 和 Range.End，但我不擅长这个。有人可以帮我写代码吗？

Sub test()
Dim Word As Object, WordDoc  As Object
Dim r As Boolean, f As Boolean, fO As Long
Set Word = CreateObject("Word.Application")
Set WordDoc = Word.Documents.Open(Filename:=Application.ThisWorkbook.path & "\test.docx")

'''name'''
Set r = WordDoc.Range
Do While UnifiedSearch(r, "name*book1")
    If f Then
        If r.Start = fO Then
            Exit Do
        End If
    Else
        fO = r.Start
        f = True
    End If
    WordDoc.Range(r.Start + 4, r.End - 5).Copy
    Range("C4").Select
    ActiveSheet.Paste
    Set r = WordDoc.Range(r.End, r.End)
Loop

WordDoc.Close
Word.Quit

End Sub

Private Function UnifiedSearch(r As Range, s As String) As Boolean

     With r.Find
        .ClearFormatting
        .Text = s
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
        UnifiedSearch = .Execute
    End With

End Function

Answer 1

我不清楚您的所有代码应该做什么，但我更改了第一部分以搜索两个术语，然后将要搜索的范围设置为两个术语之间的所有内容（包括术语本身） .我使用了多个范围，以便始终清楚哪个范围指的是哪个内容。

我必须对您的代码进行一些更正，例如您将 r 声明为布尔值，而它应该是 Word.Range。我还必须更改 Word 应用程序的对象，因为需要使用 Word.Range 声明 Range 以便与 Excel Range 区分开来。或者，如果您没有设置对 Word 对象库的引用，则需要将这些声明更改为 Object。

注意需要如何使用Duplicate 属性才能将 Range 复制到独立的 Range 对象。

Sub test()
    Dim wd As Object, WordDoc  As Object
    Dim r As Word.Range, f As Boolean, fO As Long
    Dim rStart As Word.Range, rEnd As Word.Range, rSearch As Word.Range

    Set wd = CreateObject("Word.Application")
    Set WordDoc = wd.Documents.Open(Filename:=Application.ThisWorkbook.path & "\test.docx")

    '''name'''
    Set r = WordDoc.content
    Set rStart = r.Duplicate
    If Not UnifiedSearch(rStart, "Word 1") Then
        Exit Sub
    End If
    Set rEnd = rStart.Duplicate
    rEnd.End = r.End

    If Not UnifiedSearch(rEnd, "Word 2") Then
        Exit Sub
    End If
    Set rSearch = r.Duplicate
    rSearch.Start = rStart.Start
    rSearch.End = rEnd.End

    Do While UnifiedSearch(rSearch, "name*book1")
        If f Then
            If r.Start = fO Then
                Exit Do
            End If
        Else
            fO = r.Start
            f = True
        End If
        WordDoc.Range(r.Start + 4, r.End - 5).Copy
        Range("C4").Select
        ActiveSheet.Paste
        Set r = WordDoc.Range(r.End, r.End)
    Loop
'

    WordDoc.Close
    Set WordDoc = Nothing
    wd.Quit
    Set wd = Nothing

End Sub

Private Function UnifiedSearch(ByRef r As Range, s As String) As Boolean
    Dim found As Boolean

     With r.Find
        .ClearFormatting
        .Text = s
        .Forward = True
        .wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
        found = .Execute
    End With
    Debug.Print found, s
        UnifiedSearch = found

End Function