VBA还能这么玩？Word文档一秒自动排版

大致了解完需求之后，虽然 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 NextEnd 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    识别段落类型 = rsTypeEnd 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 NextEnd 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    NextEnd 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    识别段落类型 = rsTypeEnd Function

4 后记

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

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