Microsoft Word文档中带有VBA的单词的高亮实例，包括文本框

Question

以下代码查找特定的单词并在Microsoft Word文档中突出显示它们。该代码运行正常。但是，当代码运行时，它不会在文本框中突出显示单词。我需要在常规段落和文本框中突出显示单词。我一直在搞弄它，但是我无法弄清楚。您可能需要这样做吗？

Dim Word As range

Dim WordCollection(3) As String

Dim Words As Variant

'Define list.

'If you add or delete, change value above in Dim statement.

WordCollection(0) = "Hello World 1"

WordCollection(1) = "Hello World 2"

WordCollection(2) = "Hello World 3"

WordCollection(3) = "Hello World 4"

'Set highlight color.

Options.DefaultHighlightColorIndex = wdYellow

'Clear existing formatting and settings in Find feature.

Selection.Find.ClearFormatting

Selection.Find.Replacement.ClearFormatting

'Set highlight to replace setting.

Selection.Find.Replacement.Highlight = True

'Cycle through document and find words in collection.

'Highlight words when found.

For Each Word In ActiveDocument.Words

For Each Words In WordCollection

With Selection.Find

.Text = Words

.Replacement.Text = ""

.Forward = True

.Wrap = wdFindContinue

.Format = True

.MatchCase = False

.MatchWholeWord = False

.MatchWildcards = False

.MatchSoundsLike = False

.MatchAllWordForms = False

End With

Selection.Find.Execute Replace:=wdReplaceAll

Next

Next

End Sub

找到代码here

Answer 1

对于文档范围的查找/替换，您可以遍历所有StoryRanges，因此：

Sub Demo()
Application.ScreenUpdating = False
Dim Rng As Range, h As Long, i As Long, ArrFnd(), ArrRep()
ArrFnd = Array("Hello World 1", "Hello World 2", "Hello World 3", "Hello World 4")
ArrRep = Array("Goodbye All 1", "Goodbye All 2", "Goodbye All 3", "Goodbye All 4")
h = Options.DefaultHighlightColorIndex
Options.DefaultHighlightColorIndex = wdYellow
For Each Rng In ActiveDocument.StoryRanges
  With Rng.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Replacement.Highlight = True
    .Forward = True
    .Wrap = wdFindContinue
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    For i = 0 To UBound(ArrFnd)
      .Text = ArrFnd(i)
      .Replacement.Text = ArrRep(i)
      .Execute Replace:=wdReplaceAll
    Next
  End With
Next
Options.DefaultHighlightColorIndex = h
Application.ScreenUpdating = True
End Sub

此类代码将处理文档正文，页眉，页脚，文本框等。但是，StoryRanges在Selection级别不可用。对于这些，您需要类似的东西：

Sub Demo()
Application.ScreenUpdating = False
Dim Shp As Shape, h As Long
h = Options.DefaultHighlightColorIndex
Options.DefaultHighlightColorIndex = wdYellow
With Selection
  For i = 0 To UBound(ArrFnd)
    Call RngFndRep(.Range)
  Next
  For Each Shp In .ShapeRange
    With Shp
      If Not .TextFrame Is Nothing Then
        Call RngFndRep(.TextFrame.TextRange)
      End With
    End With
  Next
End With
Options.DefaultHighlightColorIndex = h
Application.ScreenUpdating = True
End Sub

Sub RngFndRep(Rng As Range)
Dim i As Long, ArrFnd(), ArrRep()
ArrFnd = Array("Hello World 1", "Hello World 2", "Hello World 3", "Hello World 4")
ArrRep = Array("Goodbye All 1", "Goodbye All 2", "Goodbye All 3", "Goodbye All 4")
With Rng.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Replacement.Highlight = True
  .Forward = True
  .Wrap = wdFindStop
  .Format = False
  .MatchCase = False
  .MatchWholeWord = False
  For i = 0 To UBound(ArrFnd)
    .Text = ArrFnd(i)
    .Replacement.Text = ArrRep(i)
    .Execute Replace:=wdReplaceAll
  Next
End With
End Sub