如何将Excel中的数据批量导入Word模板文件

目录

 前言

步骤

 准备工作

引用加载项 

运行

代码如下：

---

 前言

文章参考 excel中的数据如何批量导入固定格式的word中？ - 知乎

       本文使用Excel中的VBA编辑器，实现将表格中数据批量填写进固定模板的word文档。本文设置了四个填充项，可根据需要自行添加更多数据导入位置。

步骤

 准备工作

1. 准备好word模板文件，将需要填写的位置用特殊变量代替

如写为：{$供应商名称}，{$采购品类}

2.打开excel-开发工具-插入-ActiveX控件

• 
• 开发工具不在工具栏中的，可按以下路径设置：
• 文件-选项-自定义功能区-开发工具

• 绘制控件后右键查看代码-进入VBA编辑器

• 进入工具-引用

 

引用加载项 

1. 选择“Microsoft Word16.0 Object Library”-浏览-在路径中找到“MSWORD.OLB”-打开-确定

• 完成配置-粘贴代码-保存

运行

1. 保存excel表类型为启用宏的

• 打开excel-点击控件-选择任一列-确定生成

• 在弹出的第一个界面中选择Word模板-第二个界面选择保存地址-确定-批量生成合同

代码如下：

Private Sub CommandButton1_Click()
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 contact_NO As String
  Dim side_A As String
  Dim side_B As String
  Dim side_C 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 '  获取选取区域总行数
  
  
  With Application.FileDialog(msoFileDialogFilePicker)
    .Filters.Add "word文件", "*.doc*", 1
    .AllowMultiSelect = False
    If .Show Then strTemplates = .SelectedItems(1) Else Exit Sub
  End With
  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
     contact_NO = Cells(k, 1)
     side_A = Cells(k, 2)
     side_B = Cells(k, 3)
     side_C = Cells(k, 4)'数据引用位置
     
  Set objDoc = objApp.Documents.Open(strTemplates, , False)
  strFileName = contact_NO & ".doc"
  If Not strFileName Like "*.doc" Then strFileName = strFileName = strFileName & ".doc"
  If Dir(strFileName) <> "" Then Kill strFileName
  
  With objApp.Application.Selection
    .Find.ClearFormatting
    .Find.Replacement.ClearFormatting
    With .Find
              .Text = "{$供应商}"
              .Replacement.Text = contact_NO
    End With
     .Find.Execute Replace:=wdReplaceAll
     
     With .Find
         .Text = "{$供应商名称}"
         .Replacement.Text = side_A
    End With
    .Find.Execute Replace:=wdReplaceAll
    
    With .Find
      .Text = "{$采购品类}"
      .Replacement.Text = side_B
    End With
.Find.Execute Replace:=wdReplaceAll
     
     With .Find
      .Text = "{$结算方式}"
      .Replacement.Text = side_C
    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