通過VBA宏突出顯示Word檔案中選定范圍內的特定單詞的問題

我正在嘗試選擇兩個單詞之間的范圍，然后嘗試在找到的范圍內找到一個單詞，最后為該單詞著色。在影像中，我想選擇“觀察”和“支持資訊”之間的范圍，然后搜索“管理”字樣并將它們涂成紅色。但是使用我的代碼，我只能突出顯示單詞的第一次出現。有人可以在這里幫助我嗎？

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

uj5u.com熱心網友回復：

使用 Find 突出顯示文本的代碼修改版本。

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

uj5u.com熱心網友回復：

Word 中的 Find 方法可能有點難以管理。您想要實作的目標必須通過回圈內的兩次搜索來完成。第一個搜索找到下一個“觀察：”，第二個搜索找到以下“支持資訊：”。然后，您使用第一次搜索的結尾和第二次搜索的開始來生成需要設為“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）短缺。

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

標籤：vba ms-word

上一篇：使用來自另一個列的資料填充AccessListBox列

下一篇：通過VBA將大量圖表從Excel復制并粘貼到PowerPoint