通过 VBA 宏在 Word 文档中突出显示选定范围内的特定单词时出现问题

Question

我正在尝试 select 两个词之间的范围，然后尝试在找到的范围内找到一个词，最后为该词着色。在图像中，我想 select 介于“观察”和“支持信息”之间，然后搜索“管理”字词并将它们着色为红色。但是使用我的代码，我只能突出显示该词的第一次出现。有人可以在这里帮助我吗？

Sub RevisedFindIt4()
' Purpose: highlight the text between (but not including)
' the words "Observation:" and "Supporting Information:" if they both appear.
Dim rng1 As Range
Dim rng2 As Range
Dim rngFound As Range

On Error Resume Next

Application.DisplayAlerts = False
Application.ScreenUpdating = False


    Set rng1 = ActiveDocument.Range
        If rng1.Find.Execute(FindText:="Observation:") Then
            Set rng2 = ActiveDocument.Range(rng1.End, ActiveDocument.Range.End)
            If rng2.Find.Execute(FindText:="Supporting Information:") Then
                Set rngFound = ActiveDocument.Range(rng1.End, rng2.Start)
                If rngFound.Find.Execute(FindText:="Management") Then
                    rngFound.Select
                    Selection.Range.HighlightColorIndex = wdRed
                End If
            End If
        End If
    Selection.HomeKey wdStory

Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Answer 1

Word 中的 Find 方法管理起来有点棘手。您想要实现的目标必须通过循环内的两次搜索来完成。第一次搜索找到下一个 'Observation:'，第二次搜索找到下面的 'Supporting Information:'。然后，您使用第一次搜索的结尾和第二次搜索的开始来生成需要制作的范围 'wdRed'

以下代码在我的电脑上运行良好

Option Explicit

Sub RevisedFindIt4()
' Purpose: highlight the text between (but not including)
' the words "Observation:" and "Supporting Information:" if they both appear.
'Application.DisplayAlerts = False
'Application.ScreenUpdating = False

    Dim myOuterRange As Word.Range
    Set myOuterRange = ActiveDocument.StoryRanges(wdMainTextStory)
    With myOuterRange
        
        Do
            With .Find
            
                .ClearFormatting
                .MatchWildcards = True
                .Text = "(Observation)([: ]{1,})(^13)"
                .Wrap = wdFindStop
                
                If Not .Execute Then Exit Do
                
            End With
                
            Dim mystart As Long
            mystart = .End
            
            .Collapse direction:=wdCollapseEnd
            .Move unit:=wdCharacter, Count:=1
            myOuterRange.End = ActiveDocument.StoryRanges(wdMainTextStory).End
            
            
            With .Find
            
                .ClearFormatting
                .MatchWildcards = True
                .Text = "^13Supporting Information"
                .Wrap = wdFindStop
                
                
                If Not .Execute Then Exit Do
                
            End With
            
            Dim myEnd As Long
            myEnd = .Start
            
            ActiveDocument.Range(mystart, myEnd).Font.ColorIndex = wdRed
            
            .Collapse direction:=wdCollapseEnd
            .Move unit:=wdCharacter, Count:=1
            myOuterRange.End = ActiveDocument.StoryRanges(wdMainTextStory).End
            
        Loop
        
    End With
    
        
'Application.ScreenUpdating = True
'Application.DisplayAlerts = True
End Sub

更新这是我第一次写的代码。我责怪饼干 (cookie) 短缺第二次误读 post 并将我的代码修改为第一次提供。

Sub RevisedFindIt4()
' Purpose: highlight the text between (but not including)
' the words "Observation:" and "Supporting Information:" if they both appear.
'Application.DisplayAlerts = False
'Application.ScreenUpdating = False

    Dim myOuterRange As Word.Range
    Set myOuterRange = ActiveDocument.StoryRanges(wdMainTextStory)
    With myOuterRange
        
        Do
            With .Find
            
                .ClearFormatting
                .MatchWildcards = True
                .Text = "(Observation:)(*)(Supporting Information:)"
                .Wrap = wdFindStop
                
                If Not .Execute Then Exit Do
                
            End With
            
            Dim myInnerRange As Word.Range
            Set myInnerRange = .Duplicate
            
            With myInnerRange
                
                With .Find
                
                    .Text = "Management"
                    .Replacement.Font.ColorIndex = wdRed
                    .Wrap = wdFindStop
                    .Execute Replace:=wdReplaceAll
                    
                    
                End With
                
            End With
            
            .Collapse Direction:=wdCollapseEnd
            .Move unit:=wdCharacter, Count:=1
            myOuterRange.End = ActiveDocument.StoryRanges(wdMainTextStory).End
            
        Loop
        
    End With
    
        
'Application.ScreenUpdating = True
'Application.DisplayAlerts = True
End Sub

Answer 2

使用“查找”突出显示文本的代码修改版本。

Sub RevisedFindIt4()
    ' Purpose: highlight the text between (but not including)
    ' the words "Observation:" and "Supporting Information:" if they both appear.
    Dim rng1 As Range
    Dim rng2 As Range
    Dim rngFound As Range
    Dim highlightIndex As Long
    

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    'capture current highlight color so that it can be reset later
    highlightIndex = Options.DefaultHighlightColorIndex
    Options.DefaultHighlightColorIndex = wdRed

    Set rng1 = ActiveDocument.Range
    If rng1.Find.Execute(FindText:="Observation:") Then
        Set rng2 = ActiveDocument.Range(rng1.End, ActiveDocument.Range.End)
        If rng2.Find.Execute(FindText:="Supporting Information:") Then
            Set rngFound = ActiveDocument.Range(rng1.End, rng2.Start)
            With rngFound.Find
                .Replacement.highlight = True
                .Execute Replace:=wdReplaceAll, Forward:=True, FindText:="Management", ReplaceWith:="", Format:=True
            End With
        End If
    End If

    Options.DefaultHighlightColorIndex = highlightIndex
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

通过 VBA 宏在 Word 文档中突出显示选定范围内的特定单词时出现问题

Problem highlighting specific words within the selected range in Word document through VBA Macros

vba

ms-word