如何高效查找和标注所有底纹文字

gemj

问题：

附件的文档中，有很多加了底纹的文字（通过 段落-边框和底纹-底纹 设置的文字底纹），底纹颜色各异。

现在想把这些底纹都找出来，并且高亮显示。

守柔版主曾写过批量提取段落底纹的代码，但无法直接在这里引用。那是对整个段落都有底纹的情况，处理思路，就是遍历段落。现在，我们是要处理段落中一部分文字的底纹。

下面代码，是借用论坛里遍历文档字符的办法，勉强实现了：

1. Sub FindAllShadings查找标注所有底纹文字()
   
2.     Application.ScreenUpdating = False
   
3.     On Error Resume Next
   
4.     Dim Doc As Document, nr As Range
   
5.     Set Doc = Word.ActiveDocument
   
6.     For i = 0 To Doc.Range.End + 1
   
7.             Set nr = ActiveDocument.Range(i, i + 1)
   
8.             If nr.Shading.BackgroundPatternColor <> wdColorAutomatic Then
   
9.                 nr.HighlightColorIndex = wdYellow
   
10.             End If
    
11.     Next
    
12.     Application.ScreenUpdating = True
    
13. End Sub

复制代码

但问题是，这样处理，效率就太低了，一本书，如果有几十万字，这个代码实际上是不可行的。

请教大神们，如何改进代码，高效实现啊？

万分感谢啦！

gemj

请教如何快速选中word中大量有底纹的文字？
https://club.excelhome.net/thread-123823-1-1.html
(出处: ExcelHome技术论坛)

我说的守柔版主的代码，在这个帖子里。

wdpfox

几十万字的word打开后一定很卡

gemj

wdpfox 发表于 2022-6-13 19:29
几十万字的word打开后一定很卡

打开文档本身并不卡，但一运行，基本就不动了。

sylun

可试试如下代码

1. Sub test()
   
2.     '假设原文档无突出显示设置
   
3.    
   
4.     Options.DefaultHighlightColorIndex = wdYellow
   
5.     Application.ScreenUpdating = False
   
6.     With Me.Content.Find
   
7.         .ClearFormatting
   
8.         .Font.Shading.BackgroundPatternColor = wdColorAutomatic
   
9.         .Replacement.Highlight = True
   
10.         .Execute Replace:=wdReplaceAll '将无底纹的字符设置为突出显示
    
11.         Stop
    
12.         .ClearFormatting
    
13.         .Highlight = False
    
14.         .Replacement.ClearFormatting
    
15.         .Replacement.Font.ColorIndex = wdWhite
    
16.         .Execute Replace:=wdReplaceAll  '将非突出显示字符设为白色
    
17.         Stop
    
18.         Me.Content.HighlightColorIndex = wdNoHighlight '取消突出显示
    
19.         .ClearFormatting
    
20.         .Font.ColorIndex = wdWhite
    
21.         With .Replacement
    
22.             .ClearFormatting
    
23.             .Font.ColorIndex = wdAuto
    
24.             .Highlight = True
    
25.         End With
    
26.         .Execute Replace:=wdReplaceAll  '将白色字符设为突出显示并设回自动色
    
27.     End With
    
28.     Application.ScreenUpdating = True
    
29. End Sub

复制代码

因底纹颜色有多种，只好采用反向查找法，且过渡格式设置似乎复杂了点，不知处理速度如何，也许有更简便的方法

gemj

sylun 发表于 2022-6-13 22:47
可试试如下代码

因底纹颜色有多种，只好采用反向查找法，且过渡格式设置似乎复杂了点，不知处理速度如何 ...

感谢sylun大神！
经测试，这个代码处理速度，那是闪电一般！
原来，在WORD的 查找-替换为 框里，不支持查找的文字底纹，在VBA里，也可以。
其他在 查找-替换为 里不支持查找和替换为的字体属性，以后也可以在VBA里试试~
这个代码，又打开了通往更自由世界的一扇大门~
有求必应，几乎无所不能，谓之大神！
感谢感谢！

gemj

1.     With Me.Content.Find
   
2.         .ClearFormatting
   
3.         .Font.Shading.BackgroundPatternColor = wdColorAutomatic
   
4.         .Replacement.Highlight = True
   
5.         .Execute Replace:=wdReplaceAll '将无底纹的字符设置为突出显示
   
6.         Stop

复制代码

这句代码：.Font.Shading.BackgroundPatternColor = wdColorAutomatic
如果直接支持：.Font.Shading.BackgroundPatternColor <> wdColorAutomatic
那中间过渡，都不需要了，直接解决。


VBA貌似不能直接支持，我们能不能通过代码实现？
这样的话，很多时候就更方便了。
因为，这就相当于实现了在格式查找上，也能支持字符查找中“非”的思想，有时候还是非常实用的！
好比，我们有时会希望“查找所有红色之外所有颜色的文字”，或者“查找所有5号字之外的所有文字”等。