查找并选中指定字符串，并添加灰色底纹

九元陈浩

想请教，如何查找word文档中的特定字符串，并将字符串刷上灰色底纹（highlightcolor）特定字符串： “3.00 MM SLUSH”，“*** FLAPS 05 ***”，“AIR COND AUTO”，“AIR COND OFF”使用了如下代码进行设置，但是并不能保存修改。关闭并打开文件后，颜色并没有添加。

Sub 增加阴影()
Dim k As FileDialog
Set k = Application.FileDialog(3)
k.Show
For Each i In k.SelectedItems
    Documents.Open i
    Set 范围 = ActiveDocument.Content
    范围.Find.ClearFormatting
    范围.Find.ClearHitHighlight
    范围.Find.HitHighlight FindText:="3.00 MM SLUSH", HighlightColor:=wdColorGray25
    范围.Find.HitHighlight FindText:="*** FLAPS 05 ***", HighlightColor:=wdColorGray25
    范围.Find.HitHighlight FindText:="AIR COND AUTO", HighlightColor:=wdColorGray25
    范围.Find.HitHighlight FindText:="AIR COND OFF", HighlightColor:=wdColorGray25
    ActiveDocument.Close savechanges:=wdSaveChanges
Next
End Sub

413191246se

楼主 新人 朋友，你好！欢迎！——Highlight 是 突出显示，一般设为亮绿色比较美观（wdBrightGreen）。如果你喜欢灰色的，就用 wdGray25 也行。请试用下面的宏：

1. Sub aaaa_HighlightGray()
   
2.     Dim arr, i&
   
3.     arr = Array("3.00 MM SLUSH", "\*\*\* FLAPS 05 \*\*\*", "AIR COND AUTO", "AIR COND OFF")
   
4.     For i = 0 To UBound(arr)
   
5.         With ActiveDocument.Content.Find
   
6.             .ClearFormatting
   
7.             .Text = arr(i)
   
8.             .Forward = True
   
9.             .MatchWildcards = True
   
10.             Do While .Execute
    
11.                 With .Parent
    
12.                     .HighlightColorIndex = wdGray25
    
13.                 End With
    
14.             Loop
    
15.         End With
    
16.     Next
    
17.     ActiveDocument.Close SaveChanges:=wdSaveChanges
    
18. End Sub

复制代码

九元陈浩

413191246se 发表于 2021-12-26 19:50
楼主 新人 朋友，你好！欢迎！——Highlight 是 突出显示，一般设为亮绿色比较美观（wdBrightGreen）。如果 ...

您好，参考您给的代码，我加了一个文件夹的循环，以便能批量处理，
但是添加灰色底纹的效果还是有点偏差。第一页的第一行全部添加了底纹， "*** FLAPS 05 ***"没有进行添加
我把部分文档也发您一下，您可以帮我再看看吗？文档奇偶页的区别是"AIR COND AUTO", "AIR COND OFF"

Sub highlight()
Dim arr, i&
arr = Array("3.00 MM SLUSH", "*** FLAPS 05 ***", "AIR COND AUTO", "AIR COND OFF")
Dim k As FileDialog
Set k = Application.FileDialog(3)
k.Show
For Each j In k.SelectedItems
    Documents.Open j
    For i = 0 To UBound(arr)
    With ActiveDocument.Content.Find
            .ClearFormatting
            .Text = arr(i)
            .Forward = True
            .MatchWildcards = True
            Do While .Execute
                With .Parent
                    .HighlightColorIndex = wdGray25
                End With
            Loop
        End With
    Next
    ActiveDocument.Close SaveChanges:=wdSaveChanges
Next
End Sub

413191246se

楼主，请你仔细看看我第 2 楼第 3 行的代码，你把斜杠 “\” 给弄哪里去了？没有斜杠，结果当然不正确了！

九元陈浩

413191246se 发表于 2021-12-28 20:48
楼主，请你仔细看看我第 2 楼第 3 行的代码，你把斜杠 “\” 给弄哪里去了？没有斜杠，结果当然不正确了！

哦哦，实在不好意思。
非常感谢！