题外：由于漏掉了勾选Microsoft Word 16.0 Object Library这个关键步骤(不勾选是无法导出的)，故修改后再次发出。本期我是从知乎上的郭大牛老师那里学的，非常建议大家去阅读，这里真的拜谢郭大牛老师。

https://zhuanlan.zhihu.com/p/76755973?utm_source=wechat_session&utm_medium=social&utm_oi=842149456383193088郭大牛：根据Excel数据生成Word文档

虽然代码可能有一点难，但由于实在是太便利，觉得还是应该拿出来，哪怕简化后的，也是有作用的，主要还是要尽力尝试。开始正题。先看视频。本次只是针对Excel单行数据的单次Word文档填充，逻辑关系上是比较简单的。如果再往下想，循环填充多行，批量形成多个Word文档也是可以的，这个就以后再说了。这一次由于关联到Word，我们要先按如下顺序操作：Excel开发工具栏→VB编辑器→工具→引用→找到Microsoft Word 16.0 Object Library并打钩→确定。这样我们才能关联到Word，实质相当于一个Excel和Word之间的接口。

思路是这样的：定义变量→变量赋值→窗口选择Word模板文件→打开Word模板文件→替换内容→另存替换后的Word文件一、定义变量

Dim StarGun As ObjectDim WordD As ObjectDim PathW As StringDim Tit, TheDate, SP, AP As StringDim a As Integer

这里先把StarGun和WordD定义为对象，PathW、Tit、TheDate、SP、AP定义为字符串型变量，a定义为整数。二、赋值

            a = ActiveCell.Row          Tit = Cells(a, 2)      TheDate = Format(Cells(a, 1), "mm月dd日")           SP = Format(Cells(a, 5), "#0.00")           AP = Format(Cells(a, 11), "#0.00")        Level = Cells(a, 12) & "级"

ActiveCell.Row即取值当前选择的单元格的行号，然后把想要替换的单元格的内容赋值于剩下的5个变量内。如果想要替换更多的单元格内容，就要赋值更多的变量。Format用于调整对象格式。三、窗口选择Word模板文件

With Application.FileDialog(msoFileDialogFilePicker)          .Filters.Add "word文件", "*.doc*", 1         .InitialFileName = "C:\Users\Dick\Desktop\vba撰写\"         .AllowMultiSelect = False         If .Show Then PathW = .SelectedItems(1) Else Exit Sub    End With

以上可以解读为：在指定路径下(.InitialFileName = "C:\Users\Dick\Desktop\vba撰写\")，选择文件名含有".doc"的Word文档，只能选择一个Word文档；如果没有选择文件则直接退出本次命令执行。四、打开Word模板文件

    Set StarGun = CreateObject("Word.Application")          StarGun.Visible = True    Set WordD = StarGun.Documents.Open(PathW, , False)

这一段三句功能为打开第三步选择的Word模板文件，其中StarGun.Visible意义在于使这个Word文件打开时处于可见状态，如果为False则是不可见，其它句子就不必纠结了。五、替换内容

本例代码中这一部分虽然比较长，但是基本都是一个个点对点的替换动作，这里只取其一做解释。

With StarGun.Application.Selection        .Find.ClearFormatting                .Find.Replacement.ClearFormatting                With .Find             .Text = "{$监测点名称}"             .Replacement.Text = Tit        End With        .Find.Execute Replace:=wdReplaceAll    End With

以此为例，主要意思就是把已打开的Word模板中的{$监测点名称}，替换为变量Tit(Tit已经赋值)。.Find.Execute Replace:=wdReplaceAll是Word的VBA命令，意思为替换所有内容，每一个变量替换都要带这一句，缺少了会报错。如果需要增减修改替换的变量，复制With .Find至wdReplaceAll，修改赋给Text的内容即可。六、另存替换后的Word文件

   WordD.SaveAs  ThisWorkbook.Path & "\" & "监测点数据Word" & "(" & Tit & ")" & ".doc"

关于Save as在第二篇宏录制里有解释，这里就不再赘述了。附上完整代码

Sub 按钮8_Click()Dim StarGun As Object 'Word.ApplicationDim WordD As Object 'Word.DocumentDim PathW As String '模板文件路径名Dim Tit, TheDate, SP, AP As StringDim a As Integer         a = ActiveCell.Row       Tit = Cells(a, 2)   TheDate = Format(Cells(a, 1), "mm月dd日")        SP = Format(Cells(a, 5), "#0.00")        AP = Format(Cells(a, 11), "#0.00")     Level = Cells(a, 12) & "级"    With Application.FileDialog(msoFileDialogFilePicker)   '窗口打开Word文件并不选时报错         .Filters.Add "word文件", "*.doc*", 1         .InitialFileName = "C:\Users\Dick\Desktop\vba撰写\"         .AllowMultiSelect = False         If .Show Then PathW = .SelectedItems(1) Else Exit Sub    End With     Set StarGun = CreateObject("Word.Application")    '打开模板文件        StarGun.Visible = True    Set WordD = StarGun.Documents.Open(PathW, , False)   With StarGun.Application.Selection    '开始替换        .Find.ClearFormatting            'ClearFormatting为清除目标位置现有格式，如加粗底色等，为后面仅作字符替换做准备        .Find.Replacement.ClearFormatting                With .Find             .Text = "{$监测点名称}"             .Replacement.Text = Tit        End With        .Find.Execute Replace:=wdReplaceAll    'wdReplaceAll是Word的VBA命令，替换所有内容         With .Find             .Text = "{$监测时间}"             .Replacement.Text = TheDate        End With        .Find.Execute Replace:=wdReplaceAll         With .Find             .Text = "{$S指数}"             .Replacement.Text = SP        End With        .Find.Execute Replace:=wdReplaceAll                 With .Find             .Text = "{$A指数}"             .Replacement.Text = AP        End With        .Find.Execute Replace:=wdReplaceAll                 With .Find             .Text = "{$风险等级}"             .Replacement.Text = Level        End With        .Find.Execute Replace:=wdReplaceAll    End With    WordD.SaveAs ThisWorkbook.Path & "\" & "监测点数据Word" & "(" & Tit & ")" & ".doc"End Sub

这套程序是我在4月份时开始使用的(我用的不太一样，文中简化了很多)，当时真挺难，几乎是每一句都读不懂，只是看出了能增减修改变量的位置，于是不明就里的就开始使用了。因此，看不看得懂可能还真不是十分重要，反正能用就行了，别的以后再说。附件在阅读全文，码【gefv】

完