|
目录
前言
步骤
准备工作
引用加载项
运行
代码如下：
前言
文章参考 excel中的数据如何批量导入固定格式的word中？ - 知乎
本文使用Excel中的VBA编辑器，实现将表格中数据批量填写进固定模板的word文档。本文设置了四个填充项，可根据需要自行添加更多数据导入位置。
步骤
准备工作
准备好word模板文件，将需要填写的位置用特殊变量代替
如写为：{$供应商名称}，{$采购品类}
2.打开excel-开发工具-插入-ActiveX控件
 开发工具不在工具栏中的，可按以下路径设置：文件-选项-自定义功能区-开发工具
绘制控件后右键查看代码-进入VBA编辑器
进入工具-引用
引用加载项
选择“Microsoft Word16.0 Object Library”-浏览-在路径中找到“MSWORD.OLB”-打开-确定
完成配置-粘贴代码-保存
运行
保存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
|