用VBA编写自定义函数，结合通配符，批量排版Word文档的标题和字体,批量删除空行等

说明：

VBA自定义函数只是减少了手动操作，这里面更大作用的就是文本通配符，建议在通配符有一定水平之后，再结合函数进行使用

一、原文档没有任何样式

二、运行设置标题自定义函数

1、批量设置标题 1

再WPS中，用“[一二三四五六七八九十]{1,3}.*^p”通配所有汉字序号开头的内容，设置为标题 1

2、运行：批量设置标题 2后

同理，通配符相同，函数中的标题 1 改为标题 2

三、运行设置字体自定义函数

运用通配符“^p[一-﨩]{1,12}：”找到所有段落标记开头，中间有1-12汉字的内容，将其设置为蓝色加粗楷体

四、代码

Option Explicit
Sub word文档自动排版_自定义函数应用()

    Call 批量设置标题("[一二三四五六七八九十]{1,3}.*^p", "标题 1", True)
    
    Call 批量设置标题("[一二三四五六七八九十]{1,3}.*^p", "标题 2", True)
    
    Call 批量设置字体1("^p[一-﨩]{1,12}：", "楷体", "2", True, True)
    
End Sub
Function 批量设置字体1(原文字, 字体为, 颜色为, 通配符, Optional ByVal 加粗 As Boolean = False)
    Dim rng As Range
    Set rng = IIf(Len(Selection.Range.text) <= 1, ActiveDocument.Content, Selection.Range)
    With rng.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .text = 原文字
        .Forward = True
        .MatchWildcards = 通配符 '通配符开关
        With .Replacement
            .Font.Name = 字体为
            .Font.Name = "Times New Roman"
            .Font.ColorIndex = 颜色为 'wdDarkRed
            .Font.Bold = 加粗
        End With
    End With
    rng.Find.Execute Replace:=wdReplaceAll
    批量设置字体1 = rng.Find.Found
    rng.Find.ClearFormatting
    rng.Find.Replacement.ClearFormatting
    Set rng = Nothing
End Function

Function 批量设置标题(原文字, 标题, 通配符)
    Dim rng As Range
    Set rng = IIf(Len(Selection.Range.text) <= 1, ActiveDocument.Content, Selection.Range)
    With rng.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .text = 原文字
        .Forward = True
        .MatchWildcards = 通配符 '通配符开关
        With .Replacement
             .Style = 标题
        End With
    End With
    rng.Find.Execute Replace:=wdReplaceAll
    批量设置标题 = rng.Find.Found
    rng.Find.ClearFormatting
    rng.Find.Replacement.ClearFormatting
    Set rng = Nothing
End Function

五、函数改编与应用

1、改编

上面的《批量设置字体1》和《批量设置标题》，都是可以进行改变的，以《批量设置字体1》函数为例，插入和注析掉一些代码，则可以改为全部替换：

'批量设置字体1_更改为全部替换
Function 全部替换(原文字, 替换为, 通配符)
    Dim rng As Range
    '设置rng对象，当有选中一部分区域时，只对选中部分进行修改，没有选中时，对全文档进行修改
    Set rng = IIf(Len(Selection.Range.text) <= 1, ActiveDocument.Content, Selection.Range)
    
    With rng.Find
        '清空查找和替换原来的设置
        .ClearFormatting
        .Replacement.ClearFormatting
        
        .text = 原文字
        .Forward = True
        .MatchWildcards = 通配符 '通配符开关
        With .Replacement
'            .Font.Name = 字体为
            '加入替换后的文字
            .text = 替换为
'            .Font.ColorIndex = 颜色为 'wdDarkRed
'            .Font.Bold = 加粗
        End With
    End With
    '执行查找
    rng.Find.Execute Replace:=wdReplaceAll
    全部替换 = rng.Find.Found
    rng.Find.ClearFormatting
    rng.Find.Replacement.ClearFormatting
    Set rng = Nothing
End Function

2、应用

（1）全部删除题目来源

比如：

1、（2022年高考真题）题目·····················

运行代码替换后：

1、题目·····················

Sub 全部删除题目来源()
    Call 全部替换("[（\(]20*[\)）]", "", True)
End Sub

（2）批量替换答案和解析

        Sub 调整答案和解析()
            Call 全部替换("答案", "【答案】", 0)
            Call 全部替换("【【答案】】", "【答案】", 0)
            Call 全部替换("解析", "【解答】", 0)
        End Sub

（3）批量删除答案的内容

注意：“-end-”需要自己手动在每个答案后面添加，标记答案的结束

Call 全部替换("【答案】*-end-", "", True)

（4）批量删除文档中的空行

Sub 批量删除文档中的空行()
    Call 全部替换("^l", "^p", False)
    Do
        If Not 全部替换("^p^p", "^p", False) Then Exit Do
    Loop
End Sub