超详细！根据 Excel 数据自动批量生成 Word 文档（VBA 完整教程）

目录

• 概述
• 环境配置
  • 需要准备的东西
  • 配置步骤
    • 1. 确认 VBA 可用
    • 2. （可选）添加 Word 对象库引用
• 操作步骤
  • 第一步：制作 Word 模板
  • 第二步：制作宏文件
    • 1. 添加按钮控件
    • 2. 进入代码框
    • 3. 粘贴代码
    • 4. 运行代码，批量生成文档
• 常见问题（FAQ）
  • Q1：执行完之后 Word 进程关不掉 / 必须手动打开一个 Word 文档才能关
  • Q2：提示「用户定义类型未定义」或「变量未定义」
  • Q3：替换没生效，文档里还是 {$Name}
  • Q4：序号变成了 1.0，或者数字变成了一长串科学计数法
  • Q5：保存时报「文件名无效」
  • Q6：WPS 里找不到「Microsoft Word 16.0 Object Library」
  • Q7：能否不弹框、直接跑固定路径？
• 数据安全提醒
• 参考

概述

本博客原文链接：https://www.cnblogs.com/kenneth2012/p/16898599.html

VBA 编程风格能看到多种面向对象语言的影子，W3School 上有专门的 VBA 基础教程。VBA 是通往办公自动化的一条捷径：它提供了大量封装好的函数，灵活性和健壮性都相当不错。

本文只做一件事：用 VBA 读取 Excel 中的数据，替换掉 Word 模板里的占位符，批量生成一堆 Word 文档。

完成后的效果：

• 自定义输出文件名规则（序号_姓名+主要关系）
• 输出到指定目录
• 一次生成几十上百份文档

2026-09 修订说明
本文初版发布于 2022-11，当时遗留了一个问题：「代码有部分 bug 没有解决，执行后需要手动打开一个 Word 文档来激活进程，然后批量关闭」。
该问题的根因已定位并修复，详见文末 Q1。下方代码已更新为修复版，可直接复制运行。

环境配置

需要准备的东西

1. Excel（Microsoft Office 或 WPS 均可）
2. Word（同上）
3. VBA 宏支持
   • Microsoft Office：自带，无需额外安装
   • WPS：需要安装「VBA 宏插件」。WPS 个人版默认不含，可在 WPS 官网下载中心获取；带 VBA 的 WPS 专业版/教育版则无需安装

⚠️ 安全提醒：网上流传的「VBA 安装包」多为第三方二次打包，来源不可控。请优先从 WPS 官网获取，不要随意运行来路不明的 .msi / .exe。

配置步骤

1. 确认 VBA 可用

打开一个 Excel 文件，看顶部菜单里有没有「开发工具」选项卡。

• 有 → 直接进入下一步
• 没有 → 文件 → 选项 → 自定义功能区 → 在右侧勾选「开发工具」

点击「开发工具」→「查看代码」，应当弹出 VBA 编辑器（VBE）窗口。

2. （可选）添加 Word 对象库引用

本文的代码采用「后期绑定」写法，不添加引用也能正常运行。 这一步的作用只是让编辑器具备 Word 对象的智能提示和自动补全。
如果你是 WPS 用户，在引用列表里找不到「Microsoft Word x.x Object Library」，直接跳过即可，不影响使用。

选择「工具」→「引用」，在列表中找到并勾选 Microsoft Word 16.0 Object Library（版本号随 Office 版本不同，旧版可能是 14.0 / 15.0）。

操作步骤

第一步：制作 Word 模板

把需要被数据替换的位置，写成下面这种占位符格式：

{$xxx}

例如 {$Name}、{$Pname}、{$Fname}、{$Rela}。其余内容随意，字体、段落、表格都不受影响。

注意事项：

• 占位符必须成对完整（{$ 开头、} 结尾），中间不要断开
• 整段占位符请保持同一种格式。如果 {$Name} 中间几个字符是另一种字体/字号，Word 会把它拆成多个查找片段，导致替换失败
• 留意 Word 的「自动更正」是否把 { } 改写成了全角字符

第二步：制作宏文件

1. 添加按钮控件

「开发工具」→「插入」→「按钮（窗体控件）」，在表格上拖一个按钮出来。

2. 进入代码框

双击按钮即可打开代码框。

如果双击没反应：先点一下「设计模式」再双击；或右键按钮 →「查看代码」。

3. 粘贴代码

把下面的代码整体粘贴进代码框，然后把 Excel 文件另存为 .xlsm（启用宏的工作簿）。

请务必先看两处配置：

1. 代码顶部的列号常量 COL_NAME / COL_RELA / COL_FNAME / COL_PNAME，要改成你自己表格对应的列
2. 过程名 CommandButton1_Click，CommandButton1 是你按钮控件的名称。双击按钮进代码框时，VBA 会自动生成对应名称的过程——如果自动生成的名称不是 CommandButton1_Click，请以自动生成的为准（直接粘贴覆盖会把绑定关系弄丢）

Option Explicit

' ===== 常量：后期绑定，无需引用 Word 对象库 =====
Private Const wdReplaceAll        As Long = 2
Private Const wdFindContinue      As Long = 1
Private Const wdFormatXMLDocument As Long = 12

' ===== 列号配置：★ 改成你自己表格的列号 =====
Private Const COL_NO    As Long = 1   ' 序号
Private Const COL_NAME  As Long = 4   ' 姓名
Private Const COL_RELA  As Long = 5   ' 主要关系
Private Const COL_FNAME As Long = 6   ' 家属姓名
Private Const COL_PNAME As Long = 7   ' 所在党组织全称


Private Sub CommandButton1_Click()          ' ★ CommandButton1 需与你的按钮控件名一致
    Dim dataAreas As Range
    Dim ws As Worksheet
    Dim tplPath As String, outDir As String, fullPath As String
    Dim startRow As Long, rowCount As Long, k As Long, done As Long
    Dim wordApp As Object, doc As Object, fd As Object
    Dim errMsg As String

    ' ---------- 1. 框选数据区域 ----------
    On Error Resume Next
    Set dataAreas = Application.InputBox( _
            Prompt:="请用鼠标框选要输出的数据区域：任选一列，覆盖所有有数据的行即可", _
            Title:="选择数据区域", Type:=8)
    On Error GoTo 0
    If dataAreas Is Nothing Then Exit Sub      ' 用户点了取消

    Set ws = dataAreas.Worksheet               ' ★ 数据取自「你框选的那张表」
    startRow = dataAreas.Row
    rowCount = dataAreas.Rows.Count

    ' ---------- 2. 选择 Word 模板 ----------
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        .Title = "① 请选择 Word 模板文件"
        .Filters.Clear
        .Filters.Add "Word 文档", "*.doc*", 1
        .AllowMultiSelect = False
        .InitialFileName = ThisWorkbook.Path
        If .Show <> -1 Then Exit Sub
        tplPath = .SelectedItems(1)
    End With

    ' ---------- 3. 选择输出目录 ----------
    ' 若你的 WPS 不支持文件夹选择框，把下面这段整体替换为：
    '     outDir = ThisWorkbook.Path
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    With fd
        .Title = "② 请选择报告输出目录"
        .InitialFileName = ThisWorkbook.Path
        If .Show <> -1 Then Exit Sub
        outDir = .SelectedItems(1)
    End With
    If Right$(outDir, 1) <> "\" Then outDir = outDir & "\"

    ' ---------- 4. 关闭刷新，加速执行 ----------
    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With

    ' ---------- 5. 后台启动 Word ----------
    Set wordApp = CreateObject("Word.Application")
    wordApp.Visible = False
    wordApp.DisplayAlerts = 0                  ' wdAlertsNone

    ' ---------- 6. 逐行生成文档 ----------
    On Error GoTo HandleErr
    For k = startRow To startRow + rowCount - 1
        Set doc = wordApp.Documents.Open(FileName:=tplPath, _
                                         ReadOnly:=False, _
                                         AddToRecentFiles:=False, _
                                         Visible:=False)

        ReplaceInDoc doc, "{$Pname}", CellText(ws.Cells(k, COL_PNAME))
        ReplaceInDoc doc, "{$Fname}", CellText(ws.Cells(k, COL_FNAME))
        ReplaceInDoc doc, "{$Name}",  CellText(ws.Cells(k, COL_NAME))
        ReplaceInDoc doc, "{$Rela}",  CellText(ws.Cells(k, COL_RELA))

        ' 文件命名规则：序号_姓名+主要关系.docx
        fullPath = outDir & SafeFileName( _
                   CellText(ws.Cells(k, COL_NO)) & "_" & _
                   CellText(ws.Cells(k, COL_NAME)) & _
                   CellText(ws.Cells(k, COL_RELA)) & ".docx")

        If Len(Dir$(fullPath)) > 0 Then Kill fullPath   ' 同名文件先删除
        doc.SaveAs FileName:=fullPath, FileFormat:=wdFormatXMLDocument
        doc.Close SaveChanges:=False                    ' ★ 关键：循环内立即关闭
        Set doc = Nothing
        done = done + 1
    Next k

    ' ---------- 7. 收尾：退出 Word、恢复设置 ----------
    wordApp.Quit SaveChanges:=False                     ' ★ 关键：显式退出，进程不再残留
    Set wordApp = Nothing

    With Application
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With

    MsgBox "报告生成完毕！共生成 " & done & " 个文件。" & vbCrLf & _
           "输出目录：" & outDir, vbInformation, "完成"
    Exit Sub

HandleErr:
    errMsg = "处理第 " & (k - startRow + 1) & " 行时出错：" & Err.Description
    On Error Resume Next
    If Not wordApp Is Nothing Then wordApp.Quit SaveChanges:=False
    Set wordApp = Nothing
    With Application
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
    MsgBox errMsg, vbCritical, "出错"
End Sub


' ============================================================
' 在文档全文范围内替换占位符
' ============================================================
Private Sub ReplaceInDoc(ByVal doc As Object, ByVal findText As String, ByVal newText As String)
    Dim rng As Object
    Set rng = doc.Content
    With rng.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = findText
        .Replacement.Text = newText
        .Forward = True
        .Wrap = wdFindContinue
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False        ' ★ 必须关闭，否则 {} 会被当成通配符表达式
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .Execute Replace:=wdReplaceAll
    End With
End Sub


' ============================================================
' 取单元格的「人眼所见」文本
' 优先用 .Text，保留「001」这类前导零格式；
' 列宽不足显示为 ### 时回退到 .Value，并把 1 格式化成 "1" 而非 "1.0"
' ============================================================
Private Function CellText(ByVal c As Range) As String
    Dim v As Variant, t As String
    t = Trim$(c.Text)
    If Len(t) > 0 And Left$(t, 1) <> "#" Then
        CellText = t
        Exit Function
    End If

    v = c.Value
    If IsEmpty(v) Then
        CellText = ""
    ElseIf IsError(v) Then
        CellText = ""                  ' 单元格是 #N/A / #VALUE! 等错误值
    ElseIf IsNumeric(v) Then
        CellText = Format$(v, "0.########")
    Else
        CellText = CStr(v)
    End If
End Function


' ============================================================
' 过滤 Windows 文件名非法字符，避免 SaveAs 时报「文件名无效」
' ============================================================
Private Function SafeFileName(ByVal s As String) As String
    Dim bad As Variant, i As Long
    bad = Array("\", "/", ":", "*", "?", """", "<", ">", "|", vbCr, vbLf, vbTab)
    For i = LBound(bad) To UBound(bad)
        s = Replace(s, CStr(bad(i)), "_")
    Next i
    Do While InStr(s, "__") > 0
        s = Replace(s, "__", "_")
    Loop
    Do While Len(s) > 0 And (Right$(s, 1) = "." Or Right$(s, 1) = " ")
        s = Left$(s, Len(s) - 1)
    Loop
    SafeFileName = Trim$(s)
End Function

4. 运行代码，批量生成文档

1. 点击按钮，弹出「选择数据区域」。此时用鼠标任选一列、覆盖所有有数据的行。例如数据在第 2~60 行，就选某一列的 2~60 行。

   

2. 点确定，弹出「选择 Word 模板文件」。选中第一步做好的模板。

   

3. 点确定，弹出「选择报告输出目录」。建议新建一个空文件夹。

4. 稍等片刻，目录中已批量生成 Word 文档，并弹出完成提示。

   

流程变化说明：初版还有一步「选择 Excel 数据文件」，现已取消。数据直接取自你框选的那张工作表，不再需要额外打开一个 Excel 实例——那既是无效开销，也是文件被占用的隐患来源。

常见问题（FAQ）

Q1：执行完之后 Word 进程关不掉 / 必须手动打开一个 Word 文档才能关

这是初版代码的 bug，现已修复。

根因：初版把 objDoc.Close 写在了 For 循环外面——循环每开一份新文档却不关闭，循环结束后只关掉了最后一份；而且全程没有调用 objApp.Quit。于是 Word 进程一直挂在后台，任务管理器里能看到一堆 WINWORD.EXE。所谓「打开一个 Word 文档来激活进程」，实质是新开的 Word 窗口接管了那批残留文档，从而能一起关掉。

修复：把 doc.Close SaveChanges:=False 移入循环内，循环结束后显式执行 wordApp.Quit SaveChanges:=False。

Q2：提示「用户定义类型未定义」或「变量未定义」

说明代码没粘贴完整。请确认 3 个 Private Const、ReplaceInDoc、CellText、SafeFileName 与主过程都在同一个模块里。

Q3：替换没生效，文档里还是 {$Name}

三种可能，按顺序排查：

1. 通配符没关。Find.MatchWildcards 必须为 False，否则 {} 会被当作通配符表达式处理，永远匹配不到。
2. 占位符被改动过。Word 的「自动更正」可能把 {} 变成了全角字符。打开「显示编辑标记」检查一下。
3. 占位符跨了格式。例如 {$Name} 中间几个字符是另一种字体，会被拆成多个片段。把整段占位符统一格式即可。

Q4：序号变成了 1.0，或者数字变成了一长串科学计数法

新版 CellText 已处理：优先读单元格显示文本，回退时用 Format$(v, "0.########")。若某列需要保留前导零（如 001），把该列设为「文本」格式即可。

Q5：保存时报「文件名无效」

姓名或关系字段里带了 / : * ? " < > | 之类的字符。新版已用 SafeFileName 自动替换为 _。

Q6：WPS 里找不到「Microsoft Word 16.0 Object Library」

跳过这一步即可。本文代码使用后期绑定（As Object + 自定义常量），不依赖该引用。

Q7：能否不弹框、直接跑固定路径？

可以。把上面第 2、3 段弹框代码删除，改成固定赋值即可：

tplPath = "D:\我的模板\模板.docx"
outDir  = "D:\输出目录\"

数据安全提醒

本文示例涉及姓名、身份证号、党组织关系等个人信息，请务必注意：

• 代码、教程、截图发布到网上之前先脱敏（示例统一用「张三/李四」，身份证号打码）
• 生成文档含个人信息，不要放在公共网盘或无权限保护的共享目录
• 处理此类数据请遵守《个人信息保护法》及所在单位的保密规定

参考

• WPS 官网 · WPS Office 下载（VBA 宏插件从官网获取）
• 根据 Excel 数据自动生成 Word 文档
• Excel 利用 VBA 批量生成 Word 报告
• Microsoft Learn · Documents.Open 方法
• Microsoft Learn · Find.Execute 方法

---

最后修订：2026-09-25