在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 声明范围才能与 Excel 范围区分开来。或者，如果未设置对 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