使用VBA通过Excel生产Word报告

1.添加按钮,在按钮上关联宏
2.在宏的工具栏选引用,选择浏览找到“C:\Program Files\Microsoft Office\root\Office16”路径中找到“”MSWORD.OLB“重新加载，并且在对象浏览器中出现”Word“字样即可
3.运行即可
注意:每次运行程序以后会弹出一个小框，需要点击’打开只读副本’以后才会继续生成word文件, 这种情况需要复制一个新的模板word文件，使用新的文件生成报告才不会有提示了

参考了这个文章
https://zhuanlan.zhihu.com/p/76755973

以下是全部代码

Private Sub CommandButton1_Click()
Sheet1.CommandButton1.Caption = "生成报告"
On Error GoTo Err_cmdExportToWord_Click
    Dim objApp As Object 'Word.Application
    Dim objDoc As Object 'Word.Document
    Dim strTemplates As String '模板文件路径名
    Dim strFileName As String '将数据导出到此文件
    Dim i As Integer
    Dim field1 As String
    Dim field2 As String
    Dim field3 As String
    Dim data_areas As Range
    Dim total_data As Integer
   
    Set data_areas = Application.InputBox(prompt:="请鼠标选择需要输出数据的区域", Title:="选择", Type:=8) '选取输出的数据区域
    i = data_areas.Row     '获取选取区域开始行所在行号
    j = data_areas.Rows.Count '  获取选取区域总行数
    MsgBox "请选择模板文件"
    With Application.FileDialog(msoFileDialogFilePicker) '选择模板文件
         .Filters.Add "word文件", "*.doc*", 1
         .AllowMultiSelect = False
         If .Show Then strTemplates = .SelectedItems(1) Else Exit Sub
    End With
    MsgBox "请选择生成文件的保存路径"
    With Application.FileDialog(msoFileDialogFolderPicker)  '获取输出的文件存储路径
         If .Show = False Then Exit Sub
         Path = .SelectedItems(1)
      End With
    Set objApp = CreateObject("Word.Application")
    objApp.Visible = False
    
    For k = i To i + j - 1
      field1 = Cells(k, 1) '第k行的第1列
      field2 = Cells(k, 2) '第k行的第2列
      field3 = Cells(k, 3) '第k行的第3列
      
      Set objDoc = objApp.Documents.Open(strTemplates, , False)
      strFileName = field1 & ".doc"
     '文件名必须包括“.doc”的文件扩展名，如没有则自动加上
      If Not strFileName Like "*.doc" Then strFileName = strFileName & ".doc"
     '如果文件已存在，则删除已有文件
      If Dir(strFileName) <> "" Then Kill strFileName
     '打开模板文件

    '开始替换模板预置变量文本
     With objApp.Application.Selection
        .Find.ClearFormatting
        .Find.Replacement.ClearFormatting
        
        '替换第1个字段
           With .Find
              .Text = "{$客户}"
              .Replacement.Text = field1
           End With
        .Find.Execute Replace:=wdReplaceAll
        
         '替换第2个字段
           With .Find
              .Text = "{$性别}"
              .Replacement.Text = field2
           End With
        .Find.Execute Replace:=wdReplaceAll
        
        '替换第3个字段
           With .Find
              .Text = "{$收益金额}"
              .Replacement.Text = field3
           End With
        .Find.Execute Replace:=wdReplaceAll
        
    End With
 
    '将写入数据的模板另存为文档文件
    objDoc.SaveAs Path & "\" & strFileName
    objDoc.Saved = True
    objDoc.Close
  Next k
     
    MsgBox "合同文本生成完毕！", vbYes + vbExclamation
Exit_cmdExportToWord_Click:
    Set objApp = Nothing
    Set objDoc = Nothing
    Set objTable = Nothing
    Exit Sub
Err_cmdExportToWord_Click:
    MsgBox Err.Description, vbCritical, "出错"
    Resume Exit_cmdExportToWord_Click
End Sub