VBA 批量生成 Word 合同：从 Excel 读取数据，自动填入模板

VBA 批量生成 Word 合同：从 Excel 读取数据，自动填入模板

适用：Excel 2016 / 2019 / 2021 / Microsoft 365 / WPS（VBA 通用） 核心：Excel 数据源 + Word 模板（书签占位）+ VBA 自动填充 = 批量生成独立合同文档

痛点：100 份合同，复制粘贴到天荒地老

做人事的，每个月要给几十名员工发劳动合同；做行政的，年会前要打印一堆邀请函；做销售的，报价单里的客户名、金额、日期每次都不同。

最常见的做法是：打开 Word 模板 → Ctrl+H 替换 → 另存为 → 再打开下一份。100 份合同，熟练工也要 1 小时以上，还容易把上一家的名字漏到下一家。

其实在 Excel 里维护好数据源，用 VBA 调用 Word 对象，点一下按钮，100 份合同自动生成。这套思路就是经典的"邮件合并"，但用 VBA 做更灵活、更可控。

整体思路：三步流水线

第一步：在 Word 模板里插书签

打开 Word，把合同模板写好。在需要替换的文字位置（比如"甲方：________"）输入占位文字，选中它，然后：

插入 → 书签 → 输入名称（如 甲方）→ 添加

常见书签命名：甲方、乙方、金额、日期、合同编号。建议用中文，和 Excel 表头一致，后续代码一看就懂。

注意：书签不要插在页眉页脚里，普通正文最容易操作；一个书签只能对应一处替换，如果同一份数据要出现多次，建议用不同书签或复制模板时多填一次。

第二步：在 Excel 里建数据源

假设 Sheet 名叫"数据源"，表头如下：

要求很简单：第一行是表头（代码从第 2 行开始读），每列对应 Word 模板里的一个书签。

第三步：写 VBA 代码

这里用后期绑定（CreateObject），好处是不需要手动引用 Word 对象库，换台电脑也能直接跑。

Option Explicit

Sub 批量生成Word合同()
Dim ws As Worksheet
Dim wdApp As Object
Dim wdDoc As Object
Dim wdDocBase As Object ' 新增：用于保存模板基础文档
Dim templatePath As String
Dim saveFolder As String
Dim lastRow As Long
Dim i As Long
Dim fileName As String

' 数据源在当前工作簿的"数据源"工作表
Set ws = ThisWorkbook.Sheets("数据源")
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

' 模板和输出文件夹，都和当前 Excel 同目录
templatePath = ThisWorkbook.Path & "\\合同模板.docx"
saveFolder = ThisWorkbook.Path & "\\生成合同\\"

' 如果输出文件夹不存在，就新建
If Dir(saveFolder, vbDirectory) = "" Then MkDir saveFolder

' 启动 Word（后期绑定）
On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If wdApp Is Nothing Then
Set wdApp = CreateObject("Word.Application")
End If
On Error GoTo 0

wdApp.Visible = False
wdApp.DisplayAlerts = False

' 先一次性打开模板作为基础文档（避免循环中反复打开）
If Dir(templatePath) = "" Then
MsgBox "找不到模板文件：【合同模板.docx】", vbCritical
wdApp.Quit
Set wdApp = Nothing
Exit Sub
End If
Set wdDocBase = wdApp.Documents.Open(templatePath)
If wdDocBase Is Nothing Then
MsgBox "无法打开模板文件，请检查文件是否被占用或损坏。", vbCritical
wdApp.Quit
Set wdApp = Nothing
Exit Sub
End If

' 从第 2 行循环到最后一行
For i = 2 To lastRow
'复制基础文档内容到新文档（不再重复打开模板）
wdDocBase.Content.Copy
Set wdDoc = wdApp.Documents.Add
wdDoc.Content.Paste

' 按书签填值（列顺序：A=甲方, B=乙方, C=金额, D=日期）
On Error Resume Next
wdDoc.Bookmarks("甲方").Range.Text = ws.Cells(i, 1).Value
wdDoc.Bookmarks("乙方").Range.Text = ws.Cells(i, 2).Value
wdDoc.Bookmarks("金额").Range.Text = ws.Cells(i, 3).Value
wdDoc.Bookmarks("日期").Range.Text = ws.Cells(i, 4).Value
On Error GoTo 0

' 生成文件名：甲方_乙方.docx，并清理非法字符
fileName = ws.Cells(i, 1).Value & "_" & ws.Cells(i, 2).Value & ".docx"
fileName = Replace(fileName, "\\", "_")
fileName = Replace(fileName, "/", "_")
fileName = Replace(fileName, ":", "_")
fileName = Replace(fileName, "*", "_")
fileName = Replace(fileName, "?", "_")
fileName = Replace(fileName, Chr(34), "_") ' 双引号用Chr(34)更安全
fileName = Replace(fileName, "<", "_")
fileName = Replace(fileName, ">", "_")
fileName = Replace(fileName, "|", "_")

'使用通用的 SaveAs 方法（后期绑定下 SaveAs2 可能不可用）
wdDoc.SaveAs saveFolder & fileName
wdDoc.Close SaveChanges:=False
Next i

' 关闭基础文档（不保存）
wdDocBase.Close SaveChanges:=False
wdApp.Quit
Set wdDoc = Nothing
Set wdDocBase = Nothing
Set wdApp = Nothing

MsgBox "已生成 " & lastRow – 1 & " 份合同！", vbInformation
End Sub

逐段看懂：这段代码在干嘛

进阶：一键批量导出 PDF

如果最终要的是 PDF 而不是 docx，把保存那一行改成：wdDoc.SaveAs saveFolder & fileName

wdDoc.ExportAsFixedFormat OutputFileName:=saveFolder & Replace(fileName, ".docx", ".pdf"), _
ExportFormat:=17 ' 17 = PDF

或者在生成 docx 后，再统一转 PDF：

wdDoc.SaveAs2 saveFolder & fileName, FileFormat:=17 ' 17 = PDF

FileFormat 小抄：docx = 16，PDF = 17，doc = 0。记不住就直接用 ExportAsFixedFormat，语义最清楚。

常见坑表（新手必看）

小结

这套"Excel + Word 模板 + VBA"的组合，本质是把数据和格式分开：Excel 管变的数据，Word 管固定的格式，VBA 做中间的搬运工。

掌握之后，不只是合同，凡是"同一份模板、批量替换不同内容"的场景都能套：邀请函、工牌、证书、报价单、通知函……改个模板、调调书签，就能复用。

下篇预告：《VBA 批量发送邮件：用 Outlook 自动发工资条》，把生成好的文件或表格直接发到每个人邮箱。