如何通过Macro按页数调整Word邮件合并文档字体大小？

以下是针对需求编写的VBA宏，可自动检测每条合并记录的页数，溢出时调整字体大小至11.5号，处理完成后恢复主文档12号字体，且完全保留原有格式（加粗、斜体、下划线等）：

完整VBA代码 #

打开Word的VBA编辑器（快捷键Alt+F11），在ThisDocument模块中粘贴以下代码：

Private Sub Document_MailMergeAfterRecordMerge(ByVal Doc As Document)
    ' 检查当前合并记录生成的文档页数
    If Doc.Content.Information(wdNumberOfPagesInDocument) > 1 Then
        ' 仅调整字体大小，不修改其他格式属性
        Doc.Content.Font.Size = 11.5
    End If
End Sub

Sub RunMailMergeWithFontAdjustment()
    ' 配置邮件合并参数（需替换为你的实际数据源信息）
    With ThisDocument.MailMerge
        .MainDocumentType = wdFormLetters
        ' 替换为你的数据源文件路径，示例为Excel文件
        .OpenDataSource Name:="C:\你的数据源文件路径.xlsx", _
            ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=True, _
            AddToRecentFiles:=False, _
            Connection:= _
            "Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=C:\你的数据源文件路径.xlsx;Mode=Read;Extended Properties=""HDR=YES;IMEX=1;""", _
            SQLStatement:="SELECT * FROM `Sheet1$`", SubType:=wdMergeSubTypeAccess
        
        ' 设置合并目标为打印机，如需生成文档可改为wdSendToNewDocument
        .Destination = wdSendToPrinter
        .SuppressBlankLines = True
        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
        ' 执行批量合并
        .Execute Pause:=False
    End With
    
    ' 合并完成后恢复主文档字体为12号
    ThisDocument.Content.Font.Size = 12
End Sub

操作步骤 #

1. 打开你的邮件合并主文档，确保已完成邮件合并的基础设置（如插入合并域）。
2. 按Alt+F11进入VBA编辑器，双击左侧项目栏中的ThisDocument打开代码窗口。
3. 粘贴上述代码，修改代码中的数据源路径和工作表名（如Sheet1$）为你的实际信息。
4. 返回Word主界面，按Alt+F8调出宏对话框，选择RunMailMergeWithFontAdjustment并点击「运行」。

关键说明 #

• Document_MailMergeAfterRecordMerge事件：每条记录合并完成后自动触发，仅当文档页数超过1页时调整字体大小，且仅修改字号，不影响其他格式属性。
• 若调整11.5号后仍溢出，可直接将代码中的11.5改为更小的数值（如11）。
• 如需合并生成新文档而非直接打印，将.Destination = wdSendToPrinter替换为.Destination = wdSendToNewDocument即可。

内容的提问来源于stack exchange，提问作者Fox