请教如何快速选中word中大量有底纹的文字？

yygg451

大家好，工作中遇到困难，且任务紧急，特向大家请教。

我在编辑一个800多页的word版用户手册，里面有大量示例，且示例都是加了底纹的，如附件文档所示（这只是文档的一小部分）。我现在需要将手册中的全部示例由五号字体换成小五字体，并提取出来拷到另一个文件，如果一点一点选中修改拷贝效率太低了，有好几本手册需要重复劳动。我试了查找替换功能，但是里面没有查找底纹这一项。

请问有没有快捷方法，可以快速选中有底纹的文字，以进行修改和拷贝。

再此先谢谢大家了。

VvHeBMBR.rar (10.35 KB, 下载次数: 46)

2005-9-22 09:18 上传

点击文件名下载附件
请教如何快速选中word中大量有底纹的文字？

yygg451

通过这几天学习，我想word里的的宏命令也许可以解决这个问题，但是因为我没有编程基础，目前还没有学会，但工作任务比较急，所以发贴希望大家先给个解决方案，我再学习。

守柔

以下代码供参考：

'* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋ '* Created By I Love You_Word!@ExcelHome 2005-9-22 10:59:52 '仅测试于System: Windows NT Word: 10.0 Language: 2052 '№ 00032^The Code CopyIn [ThisDocument-ThisDocument]^' '* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－

Option Explicit Sub Example() Dim i As Paragraph, NewDoc As Document Application.ScreenUpdating = False Set NewDoc = Documents.Add With ThisDocument For Each i In .Paragraphs If i.Shading.BackgroundPatternColor <> wdColorAutomatic Then NewDoc.Content.InsertAfter i.Range End If Next End With Application.ScreenUpdating = True End Sub '----------------------

konggs

用查找，替换。三步

konggs

第一步：查找内容：(<例*^13)([0-9])，找到后，复制粘贴到新文档中。

第二步：查找内容：[0-9]^13，替换为""(无)

第三步：查找内容：(<解*^13)(例)，替换为"/2"；

现在就只有楼主的要求，外加二个空段。空段的删除应该不会难到楼主的。

konggs

还是老大的代码运行快！[em17]

glcc-

今天到处百度无果，试了下这样操作就可以（刚刚发现这个应该是适用于文本设置突出显示的底色而不是字符底纹的情况）：
1、选中有底色的小部分文字，
2、打开“查找与替换”----“查找”，左下角“格式”选择“突出显示”，左下角“特殊格式”选择“任意字符”
3、然后点击“阅读突出显示”---“全部突出显示”
4、最后点击“在以下项中查找”选择“主文档”，即可选中全部相同底色的文本

glcc-

不过本帖附件的底纹好像是“边框与底纹”中设置的底纹，又有所不同……选择相同格式又选不全，还是vba有效

相见是缘8

守柔 发表于 2005-9-22 10:58
以下代码供参考：'* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋
'* Created By I Love  ...

大神的这个代码运行不了，不知错在那里？请路过的老师指教，谢谢！

Sub Example()

    Dim i As Paragraph, NewDoc As Document

    Application.ScreenUpdating = False

        Set NewDoc = Documents.Add

            With ThisDocument

                 For Each i In .Paragraphs

                 Ifi.Shading.BackgroundPatternColor <> wdColorAutomatic Then

                NewDoc.Content.InsertAfteri.Range

            End If

        Next

    End With

    Application.ScreenUpdating = True

End Sub

cuanju

相见是缘8 发表于 2020-3-12 07:10
大神的这个代码运行不了，不知错在那里？请路过的老师指教，谢谢！
Sub Example()    Dim i As Paragrap ...

经测试，没有发现问题。
Sub Example33()
    Dim i As Paragraph, NewDoc As Document
    Application.ScreenUpdating = False
        Set NewDoc = Documents.Add
            With ThisDocument
                 For Each i In .Paragraphs
                 If i.Shading.BackgroundPatternColor <> wdColorAutomatic Then
                NewDoc.Content.InsertAfter i.Range
            End If
        Next
    End With
    Application.ScreenUpdating = True
End Sub