Поиск между определенными словами в документе 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, поскольку диапазон должен быть объявлен с использованием Word.Range, чтобы отличить его от диапазона Excel.Или вам нужно изменить эти объявления на Object, если вы не установите ссылку на библиотеку объектов Word.

Обратите внимание, как необходимо использовать свойство 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