参考文章，下面的代码全部是基于参考网址修改得到的，非常感谢原作者

背景

朋友每天在人工出报告上需要耗费很多时间，有3个文件，一个是需要出报告用户的基本信息excel文件user.xlst，另外一个是用户的检测记录excel文件data.xlsx，生成word报告模板template.docx

说明：下面很多内容是模拟的，但是和原报告基本相似，脚本文件理论上是可以运行的，我当前电脑是mac无法运行

准备报告模板文件template.docx

准备检测记录文件data.xlsx

一个用户会有多条检测记录，取第一条检测记录的编号做为报告的编号，上面的数据按照固定格式放在第一个Sheet下面

准备用户名单user.xlsx

性别是根据身份证号码的第17位判断的，偶数为女，奇数为男

制作宏文件"报告工具.xlsm"

模板制作记录

参考顶部的链接中创建一个按钮，名字修改为：cmd_makedoc，标题修改为：生成报告
修改vba代码，开发工具–》查看代码，如果开发工具没有显示出来，请参考来调整，程序上面的变量定义建议写出来加快程序速度
代码如下

Private Sub cmd_makedoc_Click()
On Error GoTo Err_cmdExportToWord_ClickDim objApp As Object 'Word.ApplicationDim objDoc As Object 'Word.DocumentDim objDocOrigin As Object 'Word.DocumentDim xlApp As Excel.ApplicationDim xlBook As Excel.WorkbookDim xlSheet As Excel.WorksheetDim 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 m As Integer '用来循环遍历Dim h As Integer '用来循环遍历Dim l As Integer '用来循环遍历Dim userName As String '定义变量，姓名Dim sex As String '定义变量性别Dim idno As String '定义变量身份证号码Dim sampleNo As String '定义变量编号Dim takeTime(4) As String '定义变量数组，送样时间，目前暂定为4，根据实际情况修改Dim detectTime(4) As String  '定义变量数组，检测时间Dim checker(4) As String '定义变量数组, 检测人员Dim data_areas As RangeDim total_data As IntegerDim current As IntegerDim over4Names As String '定义一个字符串记录下超过4条记录的用户姓名，在最后输出提示Dim result As StringDim n As Long '用来循环遍历Dim nameArray As Variant '定义一个可变数组将检测表姓名列的数据存下来，加快遍历速度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 = FalseIf .Show Then strTemplates = .SelectedItems(1) Else Exit SubEnd WithWith Application.FileDialog(msoFileDialogFilePicker) '选择excel文件.Filters.Add "word文件", "*.xls*", 1.AllowMultiSelect = FalseIf .Show Then strData = .SelectedItems(1) Else Exit SubEnd WithWith Application.FileDialog(msoFileDialogFolderPicker)  '获取输出的文件存储路径If .Show = False Then Exit SubPath = .SelectedItems(1)End With' 忽略告警加快速度 With Application.DisplayAlerts = False.ScreenUpdating = FalseEnd WithSet objApp = CreateObject("Word.Application")objApp.Visible = FalseSet xlApp = CreateObject("Excel.Application")Set xlBook = xlApp.Workbooks.Open(strData)xlApp.Visible = False'下面去检测记录文件的第一个Sheet，可以通过名字取对应的sheet，例如xlBook.Worksheets("Sheet1")Set xlSheet = xlBook.Worksheets(1)' 将检测表第2列的姓名数据全部取出来放到数组里面，遍历数组速度比遍历xlSheet速度要快很多nameArray = xlSheet.Range("B1:B" & xlSheet.Cells(Rows.Count, "B").End(xlUp).Row).Value' 开始遍历选择的姓名和身份证For k = i To i + j - 1userName = Cells(k, 1) '取第一列的姓名idno = Cells(k, 2) '取第二列的身份证sampleNo = "" '清空编号sex = "男" '性别默认为男current = 0 '初始化为0，用于检测时间数组的数据填充'清空送样时间、检测时间、检测人员数组，防止数据错乱For h = 1 To 4takeTime(h) = ""detectTime(h) = ""checker(h) = ""Next'如果身份证号码第17位是偶数将性别修改为女性If Val(Mid(idno, 17, 1)) Mod 2 = 0 Then sex = "女"'遍历检测记录姓名数组，根据用户姓名匹配所有的检测记录, UBound(nameArray, 1)取姓名数组的最大行号'第一版程序遍历excel比较姓名是否一致：For n = 3 To xlSheet.UsedRange.Rows.Count  If xlSheet.Cells(n, 2) = patientName Then'第一版程序直接遍历excel的速度非常慢，2分钟才出一份报告，改为数组遍历以后2分钟可以出50份报告了For n = 2 To UBound(nameArray, 1)If nameArray(n, 1) = userName ThenIf Len(sampleNo) = 0 Then sampleNo = xlSheet.Cells(n, 1)current = current + 1If current < 5 ThentakeTime(current) = xlSheet.Cells(n, 4)detectTime(current) = xlSheet.Cells(n, 5)checker(current) = xlSheet.Cells(n, 12)ElseIf current = 5 Thenover4Names = over4Names & "," & userNameEnd IfEnd IfNextSet objDoc = objApp.Documents.Open(strTemplates, , False)strFileName = userName & ".docx"'文件名必须包括“.doc”的文件扩展名，如没有则自动加上If Not strFileName Like "*.docx" Then strFileName = strFileName & ".docx"'如果文件已存在，则删除已有文件If Dir(strFileName) <> "" Then Kill strFileName'打开模板文件'开始替换模板预置变量文本With objApp.Application.Selection.Find.ClearFormatting.Find.Replacement.ClearFormattingWith .Find.Text = "{$姓名}".Replacement.Text = userNameEnd With.Find.Execute Replace:=wdReplaceAllWith .Find.Text = "{$性别}".Replacement.Text = sexEnd With.Find.Execute Replace:=wdReplaceAllWith .Find.Text = "{$身份证}".Replacement.Text = idnoEnd With.Find.Execute Replace:=wdReplaceAllWith .Find.Text = "{$编号}".Replacement.Text = sampleNoEnd With.Find.Execute Replace:=wdReplaceAllWith .Find.Text = "{$年}".Replacement.Text = Year(Now)End With.Find.Execute Replace:=wdReplaceAllWith .Find.Text = "{$月}".Replacement.Text = Month(Now)End With.Find.Execute Replace:=wdReplaceAllWith .Find.Text = "{$日}".Replacement.Text = Day(Now)End With.Find.Execute Replace:=wdReplaceAll' 循环次数根据实际情况修改，demo是4条记录所以为4For m = 1 To 4With .Find.Text = "{$送样时间" & m & "}".Replacement.Text = takeTime(m)End With.Find.Execute Replace:=wdReplaceAllWith .Find.Text = "{$检测时间" & m & "}".Replacement.Text = detectTime(m)End With.Find.Execute Replace:=wdReplaceAllWith .Find.Text = "{$检测人" & m & "}".Replacement.Text = checker(m)End With.Find.Execute Replace:=wdReplaceAllNextEnd With'将写入数据的模板另存为文档文件objDoc.SaveAs Path & "\" & strFileNameobjDoc.Saved = TrueobjDoc.CloseNext'将先前的忽略告警恢复为trueWith Application.DisplayAlerts = True.ScreenUpdating = TrueEnd Withresult = "报告生成完毕！"If Len(over4Names) > 0 Then result = result & "注意下面人员超过了4次检测记录：" & over4NamesMsgBox result, vbYes + vbExclamation
Exit_cmdExportToWord_Click:Set objApp = NothingSet objDoc = NothingSet objTable = NothingSet xlApp = NothingSet xlBook = NothingSet xlSheet = NothingExit Sub
Err_cmdExportToWord_Click:MsgBox Err.Description, vbCritical, "出错"Resume Exit_cmdExportToWord_Click
End Sub

报告生成操作步骤

先将需要出报告的用户信息粘贴到"报告工具.xlsm"
点击生成报告按钮，注意如果有提示需要启用安全内容，否则无法运行VBA
弹出一个框，选择需要生成报告用户的区域，然后点击确认
弹出文件选择框，选中模板文件template.docx
弹出文件选择框，选中检测记录文件data.xlsx
弹出文件夹选择框，选中需要报告存放的目录，例如目录"报告20210103"
等待程序运行，如果有word提示的弹框"xxx文件被锁定，无法编辑"，点击"只打开副本"，目前每生成一个word需要点击一次
如果提示word的模板文件被锁定无法编辑的情况下，建议将原模板doc文件复制出来，使用新复制的doc模板文件来生成报告就不会有弹框的情况，不用每生成一个word点击一次

生成报告结果

报告20210113/张三.docx

报告20210113/李四.docx

存在的问题和待改进

每次运行程序以后会弹出一个小框，需要点击’打开只读副本’以后才会继续生成word文件, 这种情况需要复制一个新的模板word文件，使用新的文件生成报告才不会有提示了
vba代码格式比较乱
检测记录的模板中行数是固定的，demo中默认是4条，无法做到自动根据实际检测数伸缩

参考文章

官网打开word
先保存到数组里面再遍历优化匹配速度

excel利用vba批量生成word报告相关推荐

使用python 将excel中数据批量生成word周报
使用python 将excel中数据调用word模板批量生成word周报背景环境功能需求程序实现背景日常项目中每周需要召开项目周会,会议纪要和会议周报是必不可少的一项内容,会议纪要要求监理 ...
python批量生成word报告_python自动生成word报告 | 如何将现有的数据利用python 填入word的表格中？...
关于python连接SQL server数据库的问题? 你把完整的连接代码贴一下如何将现有的数据利用python 填入word的表格中? VB,VBA我会,py不会哦 DB2教程推荐,新手想学习这个 ...
python批量生成word报告_Python操作Word批量生成合同的实现示例
背景:大约有3K家商家需要重新确认信息并签订合同.合同是统一的Word版本.每个供应商需要修改合同内的金额部分.人工处理方式需要每个复制粘贴且金额要生成大写金额.基于重复工作可偷懒.用Python解救 ...
Excel用vba自动生成word
Sub GenDocfromExcel()'excel控制word,生成新文件,插入图片和文件名,保存 'office 2003, VBA工具/引用中要勾选Microsoft Word 11.0 Ob ...
如何利用VBA自动生成PPT报告
本文是继python(多级表头)之后的另一个项目,主要是利用VBA实现自动更新PPT模板的功能.主要是常规的PPT太多了, 不想把时间浪费在Ctrl+C 和Ctrl+V 之间,唯有想想自动化的可行性了 ...
如何在Excel中用VBA批量生成“照相机“图片
什么?你不知道照相机是什么??那参见我这篇文章吧 Excel做数据海报需求描述目前的状况是这样的,我有1个总表,26个子表.26个子表是按照总表的某个字段拆分出来的.然后我需要生成26个子表的照相 ...
一篇文章告诉你如何在报表系统中实现自动生成Word报告
点击获取ActiveReports v14.0最新版下载在报表系统中,生成Word报告的常见步骤分为以下四步:采集原始数据.值后台传递.生成最终报告模板.实现打印和预览.可见,系统在生成报告之前,需 ...
Excel转Word，Excel导出Word，利用Excel表批量生成Word文档，邮件合并进阶版
单击播放视频教材利用Excel数据批量生成Word文档升级版,Excel转W 01需求概述假设有图1所示的数据,需要批量生成WORD成绩通知单,通知单必须遵循图2的样式. (案例中的姓名.学校名称 ...
【收藏】Python利用Excel+模板批量生成word文件
Python利用Excel+模板批量生成word文件最近帮朋友批量生成小区业主物业费未缴的律师函.朋友那有物业那边的表格数据,包括楼栋-房间号.业主姓名.欠费日期.欠款金额等信息.目的是需要将这些表 ...
用go语言制作读取excel模板批量生成word工具
上一篇是批量生成excel的,这一篇是批量生成word的. 这里做三点说明: 第一就是这个东西到底是干嘛用的.有时候有这样的业务场景,比如说人事部门要填写很多个word,每个word都是按照特定的模板 ...

excel利用vba批量生成word报告

背景