VBA神技揭秘,Word文档排版一秒搞定，原来还能这么玩？

VBA（Visual Basic for Applications）是Microsoft Office系列软件中的一种编程语言，可以用于自动化Office应用程序中的各种任务。在Word中，使用VBA可以快速实现文档的自动排版。以下是一些基本的VBA技巧，可以帮助你在Word文档中实现一秒自动排版：
1. "设置默认格式"： - 使用VBA设置Word文档的默认字体、字号、行间距等格式。
```vba Sub SetDefaultFormatting() With ActiveDocument .ParagraphFormat.SpaceBefore = 0 .ParagraphFormat.SpaceAfter = 0 .ParagraphFormat.Alignment = wdAlignParagraphLeft .CharacterFormat.Font.Name = "宋体" .CharacterFormat.Font.Size = 12 .CharacterFormat.ParagraphFormat.LineSpacingRule = wdLineSpaceSingle End With End Sub ```
2. "自动调整行距"： - 根据文档内容自动调整行距。
```vba Sub AutoLineSpacing() With ActiveDocument.ParagraphFormat .LineSpacing = wdLineSpace1_5 .LineSpacingRule = wdLineSpaceAtLeast .LineSpacingAtLeast = 12 End With End Sub ```
3. "自动调整段落间距"： - 根据文档内容自动调整段落间距。
```vba Sub AutoParagraphSpacing() With ActiveDocument.ParagraphFormat .

相关内容：

Hello，各位小伙伴们大家好呀，真的是好久不见了。旅行者1号也才用20个小时回传数据到地球。距离 Yogurt 上次正儿八经的教程推文已经快 700 天了，时间过得真快呀，感谢各位的不离不弃。

这两天群里比较活跃，便上去看看发生了啥事儿，不看不知道，一看，这推文的素材不就来了嘛，嘿嘿。

有一个 @小婷子 的群友在群里求助

大致了解完需求之后，虽然 Word & VBA 不是很熟，但理论上大致都是相通的，查阅了一下文档，三下五除二就搞定啦。下面是 Yogurt 在这不到 1 个小时的时间里的解决过程，请各位看官笑纳。

国际惯例，先将最终效果图奉上：

视频加载中...

废话不多说，让我们开始本期的 VBA 之旅。

1 分析需求

上图是 @小婷子 在群里提供的代码示例，联系上下文以及个人经验，感觉她应该是有一个自动排版的需求。后面追问一下，果不其然，要改十几篇 Word 文档的格式。这种重复性的工作太烦人了。

联系上下文，确定下来咱们要开发的需求——根据特定的文本标识自动设置段落样式。特定的文本标识如下：

• 段落开头为 …… 等等的标识的为一级标题
• 段落开头为 …… 等等的标识的为二级标题
• 其余情况为正文

OK，需求明确了，就可以开始写代码了。

2 准备工作

首先我们先打开 Word。

然后将其保存为 .docm 格式——启用宏的 Word 文档。

这里 Yogurt 演示使用的是 Office 2021，Office 2007 版本以上 Office 操作基本大同小异，只是保存时弹出的窗口有所差别，大家注意一下保存的文件类型即可。

保存好之后，咱们需要打开 VBA 编辑界面。虽然是在 Word 里面，但我们依然可以使用 Alt + F11 这个丝滑小连招，唤出 VBA 编辑器。

然后照例先创建一个 模块 ，在对象 ThisDocment 处点击鼠标右键，依次点击： 插入 > 模块

然后咱们就回到了 Excel VBA 那熟悉的感觉了。

接着咱们准备点测试用的素材。如下图：

把咱们要测试的内容简简单单地放上去。

2 编写代码

2.1 读取所有段落

需求里提到，每个段落按照指定的段落标识设置段落的样式，那么根据需求，我们刚刚准备好的测试素材处理完之后应该长这样：

那么我们需要通过 VBA 先将每个段落的内容读取出来。

Option Explicit

Sub 自动排版()
    Dim item As Variant
    For Each item In ThisDocument.Paragraphs
        Dim pItem As Paragraph
        Set pItem = item
        Debug.Print pItem.Range.Text
    Next
End Sub

代码编写完后， F5 运行，结果如【立即窗口】所示。每个段落的文本都被代码读取到了。

2.2 识别文本标识

根据需求和测试素材我们可以找到规律：

• 只要段落开头的文本满足特定的文本标识，就执行相应的动作即可
• 否则直接执行默认动作

处理文本需求，最方便的工具就是 正则表达式 了。我们先找个在线工具验证一下想法，效果如下：

OK，两条正则表达式都能分别将 一级标题 和 二级标题 识别出来，那识别不出来的段落就是 正文 了。

逻辑可行，代码搞起来。

在 VBA 里使用正则表达式需要引用一个库 —— Microsoft VBScript Regular Expression。

在弹出的对话框中找到 Microsoft VBScript Regular Expressions 1.0 ，其中 1.0 和 5.5 在本次案例中没有什么不同，随便选一个就行了，这里 Yogurt 选择了 1.0 版本

创建一个 Function 。拿一个文本来验证一下这两条正则表达式，先测试一下一级标题。

再测试一下二级标题。

完全没问题。

细心的小伙伴想必已经发现了，怎么测试的这两条正则表达式前面都有个 ^ 。

这个符号表示从文本的第一位开始匹配。

具体正则表达式的符号含义，后面有机会再跟大家分享，或者大家也可以去搜一下，蛮简单的。

从文本的第一位开始匹配是为了更精确的识别段落，以避免像下面这种情况。

毕竟咱们的需求是 "段落开头的特定标识"。

好啦，代码测试完毕了，两条正则表达式总不能每次都自己手动修改吧，这也达不到 "自动排版" 的目的，因此我们需要一个循环来简单修饰一下。

Option Explicit

Function 识别段落类型(ByVal val As String) As String
    Dim patterns As Variant
    Dim types As Variant
    
    ' 正则表达式数组
    patterns = Array( _
        "(^{1,3}|^引言|^结语)、", _
        "^（{0,3}）" _
    )
    
    ' 样式名称数组, 注意：顺序需要与上述 patterns 一致
    ' 即：一条正则表达式对应一个样式名称
    types = Array( _
        "标题 1", _
        "标题 2" _
    )


    Dim regex As RegExp
    Set regex = New RegExp


    Dim rsType As String
    Dim i As Long
    For i = 0 To UBound(patterns)
        regex.Pattern = patterns(i)
        regex.Global = True
        If regex.Test(val) Then
            rsType = types(i)
            Exit For
        End If
    Next
    
    Set regex = Nothing
    识别段落类型 = rsType
End Function

这样我们就得到了上述的自定义函数了。我们在函数中建立了正则表达式与段落样式的关联关系，只要匹配到符合条件的正则表达式，就返回样式名称，以便程序进行自动设置。

2.3 组合使用

我们将两者结合起来，在方法 自动排版 中调用刚刚写好的 识别段落类型 函数，将参数传入，我们可以在 立即窗口 中看到识别结果，正如我们所愿。

2.4 自动设置样式

Option Explicit

Sub 自动排版()
    Dim item As Variant
    
    ' 读取所有段落
    For Each item In ThisDocument.Paragraphs
        Dim pItem As Paragraph
        Set pItem = item
        
        ' 根据段落内容识别段落格式（正则表达式）
        Dim pType As String
        pType = 识别段落类型(pItem.Range.Text)
        If pType = "" Then
            ' 默认段落设置为"正文"
            pItem.Style = ThisDocument.Styles("正文")
        Else
            ' 当段落识别出特定结果时, 执行样式设置
            pItem.Style = ThisDocument.Styles(pType)
        End If
    Next
End Sub

我们将代码完善一下，把方法 自动排版 中的段落循环针对 识别段落类型 函数的返回结果做一下判断，然后执行样式设置，运行一下，我们就可以得到下图，完美运行。

3 美化样式

说实话，微软预设的样式挺奇怪的，可能是为了让用户能够直观地区分样式与样式之间的差别。但为了满足我们的需求，最起码达到开头效果图视频中那样的话，则需要自己设置一下样式。

上图是一级标题的设置参数，具体怎么设置就不在这里赘述了，有需要的可以单独给 Yogurt 留言哈。按照设置 一级标题 的方式，将 二级标题 、 正文段落 都设置好。

然后再将 VBA 里的 标题 1 、 标题 2 和 正文 替换成刚刚设置好的样式名称，并与正则表达式相对应。最后修改好的代码如下：

Option Explicit

Sub 自动排版()
    Dim item As Variant
    
    ' 读取所有段落
    For Each item In ThisDocument.Paragraphs
        Dim pItem As Paragraph
        Set pItem = item
        
        ' 根据段落内容识别段落格式（正则表达式）
        Dim pType As String
        pType = 识别段落类型(pItem.Range.Text)
        If pType = "" Then
            ' 默认段落设置为"正文段落"
            pItem.Style = ThisDocument.Styles("正文段落")
        Else
            ' 当段落识别出特定结果时, 执行样式设置
            pItem.Style = ThisDocument.Styles(pType)
        End If
    Next
End Sub


Function 识别段落类型(ByVal val As String) As String
    Dim patterns As Variant
    Dim types As Variant
    
    ' 正则表达式数组
    patterns = Array( _
        "(^{1,3}|^引言|^结语)、", _
        "^（{0,3}）" _
    )
    
    ' 样式名称数组, 注意：顺序需要与上述 patterns 一致
    ' 即：一条正则表达式对应一个样式名称
    types = Array( _
        "一级标题", _
        "二级标题" _
    )


    Dim regex As RegExp
    Set regex = New RegExp


    Dim rsType As String
    Dim i As Long
    For i = 0 To UBound(patterns)
        regex.Pattern = patterns(i)
        regex.Global = True
        If regex.Test(val) Then
            rsType = types(i)
            Exit For
        End If
    Next
    
    Set regex = Nothing
    识别段落类型 = rsType
End Function

这效果、这气质，"der~" 一下就出来了。交差！

4 后记

这次与大家分享的虽然只是个小案例，其实也可以结合自己本岗位的需求往深了做一下，说不定可以挖掘出更多的需求，将办公自动化进行到底。秒级响应，将摸鱼也进行到底。

绝大部分时候我们都只是关注 Excel VBA，实际上 VBA 的应用之广泛让人惊叹，除了本次分享的 Word，Office 套件下还有 PPT、Access 等，其他专业领域还有 CAD 里的宏运算等等，在办公领域 VBA 的用途不可谓不不广泛，能提升优化的地方还有很多，一起加油吧！