VBA批量生成Word报告 | VBA实例教程

除非注明，文章均为战战如疯原创，转载请保留链接: http://www.zhanzhanrufeng.com/cat4/204.html，VBA交流群273624828。

今天我们继续来讲VBA中关于Word的应用。假设你是一个银行或者是理财公司的职员，每个月你都需要给在你们公司理财的客户出一份当月收益的报告，假设我们要的报告是Word版本的。如果你们公司没有成熟的系统，那你要怎么做？如果有成百上千个客户总不能一份份的去粘贴复制吧。其实像这样的报告有一个特点，就是其结构是完全一样的，只是其中的几个点需要变，像客户姓名、性别、日期、收益数额等等，而其他描述性的内容是不需要变的。这种工作有点像写信封，你只需要把几个关键点填上就好了。有的朋友可能会想到这种功能可以用Word的邮件合并功能来实现。完全正确！这里VBA程序其实就是在模拟邮件合并的过程，感兴趣的朋友可以去研究下邮件合并。现在我们来看实例，现在我已经在Excel中作好了报表所需要的数据，包括客户姓名、性别、收益、金额大写、日期等项目，现在就根据这个表来生成所有客户的报告。我们的解题思路是先制成一个报告的模板，将其中需要改的地方以某个关键字来代替，注意该关键字不要与固定内容中的词相同。例如某某先生，先生这里我们就用性别代替，之后只要报告中出现“性别”这个词我们就用先生代替。看下面的代码

Sub CreateWord()
Dim mypath, Newname, i, XB, wApp
mypath = ThisWorkbook.Path & "\"
For i = 2 To [a1048576].End(xlUp).Row
Newname = "月度收益报告-" & Range("a" & i) & ".docx" '给新生成的表起个名称
FileCopy mypath & "模板.docx", mypath & Newname '将模板复制并重命名
Set wApp = CreateObject("word.application")
With wApp
.Visible = False
.Documents.Open mypath & Newname '打开我们复制的新文件进行更改
Do While .Selection.Find.Execute("客户") '寻找客户这个关键词，将其用表格中的姓名来代替
.Selection.Text = Range("A" & i).Text
.Selection.HomeKey Unit:=6
Loop
If Range("B" & i) = "男" Then '将男改成先生，女改成女士
XB = "先生"
Else
XB = "女士"
End If
Do While .Selection.Find.Execute("性别")
.Selection.Text = XB
.Selection.HomeKey Unit:=6
Loop
Do While .Selection.Find.Execute("报告日期")
.Selection.Text = Range("F" & i).Text '替换字符串
.Selection.HomeKey Unit:=6
Loop
Do While .Selection.Find.Execute("本金金额")
.Selection.Text = Range("C" & i).Text '替换字符串
.Selection.HomeKey Unit:=6
Loop
Do While .Selection.Find.Execute("收益金额")
.Selection.Text = Range("D" & i).Text '替换字符串
.Selection.HomeKey Unit:=6
Loop
Do While .Selection.Find.Execute("金额大写")
.Selection.Text = Range("E" & i).Text '替换字符串
.Selection.HomeKey Unit:=6
Loop
.Documents.Save
.Quit
End With
Next
Set wApp = Nothing
End Sub

上面的代码首先将我们制作好的模板重新复制一下，并以客户姓名命名，之后对这个重命名后的模板进行修改，可以看到我们在修改的时候用了Do while...loop这个循环，意思就是查找文档中的所有相应关键字并改成相应的内容，将所有的内容都改完了我们的报告也就完成了，是不是很简单呢？

本节示例文件下载地址：http://pan.baidu.com/s/1kzECA。