超详细!根据EXCEL数据自动生成WORD文档
概述
本博客链接:https://www.cnblogs.com/kenneth2012/p/16898599.html
VBA编程风格可以看到多种面向对象语言的影子,W3SCHOOL有专门的VBA基础编程教程。VBA是办公自动化一个很好的途径,提供了丰富的封装好的函数,有很好的灵活性、健壮性。
本教程内容主要为:用VBA编程的方式,提取excel内容,对word模板中特定位置进行替换。
实现了:定义输出文件名、输出至文件所在路径、生成批量word文档。
请注意,由于代码有部分bug没有解决,执行后需要手动打开一个word文档来激活进程,然后批量关闭。
参考的博客、文章附在最后,感谢前人的付出。
环境配置
-
VBA编程环境。链接:https://pan.baidu.com/s/1iLXfy_85hLoxNxh1DYMRBg?pwd=gczy 提取码:gczy
安装后,可以在excel里开启VBA宏功能
-
WPS excel、word
配置步骤
-
从环境配置的网盘链接中下载压缩包。
依次执行
Vba71.msi Vba71_1033.MSI Vba71_2052.msi
-
打开一个excel文件,点击开发工具。
可以看到,开发工具里有各种选项。我们先点击查看代码。
效果应该如图所示
-
打开VBA编辑器,添加项目引用
具体操作:选择“工具”—“引用”,然后打开加载文件选择框,选择“Microsoft Word16.0 Object Library”这个项目。这个引用是必须的,否则后期在执行变量替换时,VBA无法调用Word替换功能。
如下图:
操作步骤
制作word模板
如图,将需要替换的内容以
{$xxx}
格式书写。
其他内容可随意改动。
制作宏文件
- 在excel中添加按钮控件
-
双击控件,即可打开代码框。
如果打不开,方法1:点击“设计模式”,再双击控件。方法二,点击“查看代码”,即可直接打开代码框。
-
在代码框写如下代码,并将EXCEL文件另存为XLSM
!请注意看代码注释!
Private Sub CommandButton1_Click()'这个位置按照自己控件修改,例如 '我的控件名称为"CommandButton1",自动生成了Private Sub CommandButton1_Click() '肯定会自动生成,如果打开之后发现是个空白框,请先添加按钮控件后,再查看代码 On Error GoTo Err_cmdExportToWord_Click Dim objApp As Object 'Word.Application Dim objDoc As Object 'Word.Document Dim objDocOrigin As Object 'Word.Document Dim xlApp As Excel.Application Dim xlBook As Excel.Workbook Dim xlSheet As Excel.Worksheet Dim strTemplates As String '模板文件路径名 Dim strFileName As String '将数据导出到此文件 Dim strData As String 'excel数据文件路径名 Dim i As Integer '用来循环遍历,选中姓名的起始行号 Dim j As Integer '用来循环遍历,选中区域的总行数 Dim k As Integer '用来循环遍历,选择区域遍历的行号 Dim Num As String '定义变量,序号 Dim Name As String '定义变量,姓名 Dim Fname As String '定义变量家属姓名 Dim Pname As String '定义变量所在党组织全称 Dim Rela As String '定义变量主要关系 Dim data_areas As Range Dim total_data As Integer Dim result As String Dim n As Long '用来循环遍历 Set data_areas = Application.InputBox(prompt:="请鼠标选择需要输出数据的区域", Title:="选择", Type:=8) '选取输出的数据区域 i = data_areas.Row '获取选取区域开始行所在行号 j = data_areas.Rows.Count ' 获取选取区域总行数 over4Names = "" '如果希望不弹框选择文件和存放目录可以将下面三行前面的单引号去除,再将下面一段弹框选择文件的代码删除 'strTemplates = "C:\Users\80668\Desktop\template.docx" 'strData = "C:\Users\80668\data.xlsx" 'Path = "C:\Users\80668\Desktop\报告20210113" '下面的一段代码是弹出3次框,分别选择模板文件doc,检测数据文件excel,报告存放目录 With Application.FileDialog(msoFileDialogFilePicker) '选择word模板文件 .Filters.Add "word文件", "*.doc*", 1 .AllowMultiSelect = False If .Show Then strTemplates = .SelectedItems(1) Else Exit Sub End With With Application.FileDialog(msoFileDialogFilePicker) '选择excel文件 .Filters.Add "word文件", "*.xls*", 1 .AllowMultiSelect = False If .Show Then strData = .SelectedItems(1) Else Exit Sub End With With Application.FileDialog(msoFileDialogFolderPicker) '获取输出的文件存储路径 Path = ThisWorkbook.Path End With ' 忽略告警加快速度 With Application .DisplayAlerts = False .ScreenUpdating = False End With Set objApp = CreateObject("Word.Application") objApp.Visible = False Set xlApp = CreateObject("Excel.Application") Set xlBook = xlApp.Workbooks.Open(strData) xlApp.Visible = False '下面去检测记录文件的第一个Sheet,可以通过名字取对应的sheet,例如xlBook.Worksheets("Sheet1") Set xlSheet = xlBook.Worksheets(1) ' 将检测表第4列的姓名数据全部取出来放到数组里面,遍历数组速度比遍历xlSheet速度要快很多 nameArray = xlSheet.Range("D1:D" & xlSheet.Cells(Rows.Count, "D").End(xlUp).Row).Value ' 开始遍历选择的姓名和身份证 For k = i To i + j - 1 Num = Cells(k, 1)'序号' Name = Cells(k, 4) '姓名' Pname = Cells(k, 7) '所在党组织的全称' Rela = Cells(k, 5)'主要关系' Fname = Cells(k, 6)'家属姓名' Set objDoc = objApp.Documents.Open(strTemplates, , False) '定义文件命名规则:序号_姓名+主要关系 strFileName = Num & "_" & Name & Rela & ".docx" '文件名必须包括“.docx”的文件扩展名,如没有则自动加上 If Not strFileName Like "*.docx" Then strFileName = strFileName & ".docx" '如果文件已存在,则删除已有文件 If Dir(strFileName) <> "" Then Kill strFileName '打开模板文件 '开始替换模板预置变量文本 With objApp.Application.Selection .Find.ClearFormatting .Find.Replacement.ClearFormatting With .Find .Text = "{$Pname}" .Replacement.Text = Pname End With .Find.Execute Replace:=wdReplaceAll With .Find .Text = "{$Fname}" .Replacement.Text = Fname End With .Find.Execute Replace:=wdReplaceAll With .Find .Text = "{$Name}" .Replacement.Text = Name End With .Find.Execute Replace:=wdReplaceAll With .Find .Text = "{$Rela}" .Replacement.Text = Rela End With .Find.Execute Replace:=wdReplaceAll End With '将写入数据的模板另存为文档文件 objDoc.SaveAs Path & "\" & strFileName objDoc.Saved = True Next objDoc.Close '将先前的忽略告警恢复为true With Application .DisplayAlerts = True .ScreenUpdating = True End With result = "报告生成完毕!" MsgBox result, vbYes + vbExclamation Exit_cmdExportToWord_Click: Set objApp = Nothing Set objDoc = Nothing Set objTable = Nothing Set xlApp = Nothing Set xlBook = Nothing Set xlSheet = Nothing Exit Sub Err_cmdExportToWord_Click: MsgBox Err.Description, vbCritical, "出错" Resume Exit_cmdExportToWord_Click End Sub
-
运行代码,生成word文档
-
点击按钮,弹出选择数据的提示。此时任选一列,包含所有有数据的行。
如:我的第2至第60行都有数据,那么我任选一列,选择2~60行。
- 点击确定,弹出选择模板的提示框。此时选择制作好的模板文件。
- 点击确定,弹出选择数据文件的提示框。此时选择我们的XLSM文件。
- 点击确定,此时能看到,已经在根目录中批量生成word文档。
-