使用 VBA 实现法律文书批量生成

作者: Admin 分类: 教学辅导 发布时间: 2017-04-18 05:55 ė 6 没有评论

  其实这个东东本来没有太多值得介绍的,『邮件合并』就能搞定,而且也不是针对法律文书的。只是因为邮件合并操作需要使用者能熟练操作(其实也非常简单),本文介绍的是如何快速生成法律广收,而且不需要用户熟悉邮件合并操作。事实上还可以加一个『一键生成』按钮,点击后自动生成你需要的法律文书,但本文并没有加入这个按钮。

  本文没有加入『一键生成』按钮原因是懒,呵呵。因为素材是从网上下载的,没有重新进行修改。

  具体操作方法如下:

  1. 新建一个文件夹(本例命名为VBA),在该文件夹中放置法律文书模板(本例为:模板.docx)和『数据源』(本例为:自动生成.xlsx)。
  下图为法律文书模板(仅为样例,微歌不是专业人员,见笑了):
  下图是『数据源』样例:
  2. 打开『数据源』,切到『视图』,点击『宏』标签。
  3. 点击『查看宏』在弹出的『宏』对话框中,新建一个(名字随便填就可以了,自己记得就行),然后点击『创建』。

  4. 在出现的 VBA 编辑器中,将下面的代码粘贴在出现的『模块 1』框中:

Sub production()
Dim mypath, docname, i, wApp                                        '定义变量
MkDir ThisWorkbook.Path & "\批量生成"                              '在当前路径下创建名为“批量生成”的文件夹,用于存放生成的文件
mypath = ThisWorkbook.Path & "\批量生成\"                        '指定“mypath”(本例定义的工作路径)为“批量生成”文件夹
For i = 2 To [a1048576].End(xlUp).Row                          '指定后面执行的循环范围,从第2行开始,到最后一个非空单元格为止
docname = "补偿协议-" & Range("A" & i) & ".docx"                '定义自动生成的文件名为“补偿协议-”+“A列i行的值(相应的姓名)”+“.docx”
FileCopy ThisWorkbook.Path & "\" & "模板.docx", mypath & docname  '复制当前路径下的“模板.docx”文件到指定路径(就是“批量生成”文件夹),并按上述规则重命名
Set wApp = CreateObject("word.application")                        '调用word程序打开文件,执行后面操作
With wApp
.Visible = False
.Documents.Open mypath & docname                              '打开上面复制并重命名的文件
Do While .Selection.Find.Execute("name")                      '在文件中检索“name”字符串
.Selection.Text = Range("A" & i).Text                      '使用表格A列i行的值(即相应的姓名)替换找到的“name”字符串
.Selection.HomeKey Unit:=6                                  '光标置于文件开头
Loop                                                          '循环
'(直到找不到“name”为止,当前文档中所有“name”字符串都已被替换)
Do While .Selection.Find.Execute("seniority")                  '(下面都是一样的结构,就是分别用相应列中提取出来i行的值,替换各个预设的字符串,不重复)
.Selection.Text = Range("B" & i).Text
.Selection.HomeKey Unit:=6
Loop
Do While .Selection.Find.Execute("unit")
.Selection.Text = Range("C" & i).Text
.Selection.HomeKey Unit:=6
Loop
Do While .Selection.Find.Execute("compensation")
.Selection.Text = Range("D" & i).Text
.Selection.HomeKey Unit:=6
Loop
Do While .Selection.Find.Execute("inwords")
.Selection.Text = Range("E" & i).Text
.Selection.HomeKey Unit:=6
Loop
Do While .Selection.Find.Execute("status")
.Selection.Text = Range("F" & i).Text
.Selection.HomeKey Unit:=6
Loop
Do While .Selection.Find.Execute("id")
.Selection.Text = Range("G" & i).Text
.Selection.HomeKey Unit:=6
Loop
Do While .Selection.Find.Execute("phone")
.Selection.Text = Range("H" & i).Text
.Selection.HomeKey Unit:=6
Loop
Do While .Selection.Find.Execute("address")
.Selection.Text = Range("I" & i).Text
.Selection.HomeKey Unit:=6
Loop
Do While .Selection.Find.Execute("bank")
.Selection.Text = Range("J" & i).Text
.Selection.HomeKey Unit:=6
Loop
Do While .Selection.Find.Execute("account")
.Selection.Text = Range("K" & i).Text
.Selection.HomeKey Unit:=6
Loop
.Documents.Save
.Quit
End With
Next
Set wApp = Nothing
End Sub

 

  结果如下图所示:
  将这个 EXCEL 文件保存为:自动生成.xlsm(启用宏的工作簿)。
  5. 打开新保存的『批量生成.xlsm』,再次打开『宏』对话框(方法同上),选定刚才创建的项目,点击『执行』按钮,代码开始运行。执行完毕后,即完成了自动生成工作,生成的文书放在『自动生成』文件夹中。
  扩展提示:

  实现特定字符串查找和替换功能的模块如图所示。
  每个红框内是一个字符串的替换模块,蓝色下划线标出的是需改动的值。如果需要增加、减少、调整替换目标和内容,对代码做相应修改即可。

本文出自微歌,转载时请注明出处及相应链接。

本文永久链接: http://wego2.com/shi-yong-VBA-shi-xian-fa-lv-wen-shu-pi-liang-sheng-cheng.html

0

发表评论

电子邮件地址不会被公开。 必填项已用*标注

Ɣ回顶部