基于VBA 和DocVariable 域实现合同文档的自动生成

刘铁生

（唐山三友氯碱有限责任公司设备部，唐山063305）

0 引言

Visual Basic for Applications（简称VBA）是新一代标准宏语言，是基于Visual Basic for Windows 发展而来的。VBA 是目前可用的最容易学习、最容易使用同时也是最复杂的应用程序自动化语言（过去常常称为宏语言）之一。OFFICE 用户可以很容易地将日常工作转换为VBA 程序代码，使工作自动化。VBA 语言的使用，对于解决工作中的难题、困难，易如反掌。它可以让复杂的工作简易化，减少不必要的重复性工作，大大提高我们的工作效率。

DocVariable 域代码插入到文档变量分配的字符串。每个文档具有变量，可以添加和引用通过使用VBA 编程语言的应用程序的集合。此字段使您能够在文档中显示文档变量的内容。使用快捷键：Ctrl+F9，Word 文档会出现一对对应的大括号{}，中间为灰色，我们在大括号中间输入{docviarable 变量名}，然后再按F9就可以了。对这个域代码，我们可以通过Shift+F9 来切换显示，Word 会交替显示{docviarable 变量名}和变量值。如果文档中有多个域代码，我们就使用Alt+F9来切换显示。

以单位外委维修项目合同签订为例，期间共计产生合同文档9 项。以前的传统做法是，每次安排新的合同都需要在模版或上一个合同的基础上进行手工修改，有关信息还需要在多个文档来回切换，进行复制粘贴。事实证明此种方法不仅效率低下，出错率更高。

其工作流程如图1 所示。

图1 流程图

而本文中仅仅需要在Excel 合同台账中及时把相应变量信息填写上即可。变量主要集中在竞价单位、竞价单位数量、报价信息、报价截止日期、中标单位、中标金额以及开户银行、账号等，随着竞价程序的进行，变量值通过VBA 代码计算出来，同时相关文档被批量生成。在所需文档生成的同时，合同台账也被健全完善，可谓事半功倍，为今后的数据分析工作也打下了基础。

1 算法实现

1.1 Word模版准备

根据单位制式要求，在原有文档的基础上，对变量部分进行改造。主要利用Word 的DocVariable 域功能，通过VBA 代码实现Excel 和Word 模版之间的数据传递。这样做的好处是灵活，适应性强，极大避免了因Word 模版内容的微调，造成程序无法运行。

以邀请函模版为例说明，DocVariable 域代码的设置方法。在需要的位置分别插入竞价单位、项目名称、报价截止日期的域代码。如图2 所示。

图2 邀请函模版

Excel 合同数据明细如表1。

表1

1.2 实现代码

（1）邀请及回执的生成

Excel 数据传入变量，实例代码如下：

Set wk=ThisWorkbook

Set sh=wk.Sheets（"明细"）

arr=sh.Range（"a1"）.CurrentRegion

For i=2 To UBound（arr）

项目名称=arr（i，3）

竞价单位=arr（i，1）

报价截止日期=arr（i，5）

Next i

变量传入Word 模版，实例代码如下：

Set odoc = WordApp.Documents.Open（ThisWorkbook.Path &

""&"邀请函.doc"）

With odoc

For Each doc_var In odoc.Variables

doc_var.Delete

Next

.Variables.Add Name:="竞价单位"，Value:=竞价单位

.Variables.Add Name:="项目名称"，Value:=项目名称

.Variables.Add Name:="报价截止日期"，Value:=Format（报价截止日期，"yyyy 年mm 月dd 日"）

.Fields.Update.

Fields.Unlink

End With

按照文档命名规则另存生成文档到规定文件夹，实例代码如下：

If Dir（ThisWorkbook.Path & "" & 项目号& ""，vbDirecto⁃ry）= "" Then MkDir（ThisWorkbook.Path & "" & 项目号&""）

odoc.SaveAs ThisWorkbook.Path & "" & 项目号& "" & 项目号&竞价单位&"邀请函及回执.doc"

odoc.Close False

执行过程：点击对应过程按钮即可，借助本机out⁃look 程序，直接将邀请函及回执以附件形式发送到竞价单位电子邮箱。

图3 执行过程

代码实现的功能，类似Word 邮件合并。但邮件合并功能缺点有以下几点：

①邮件合并的用法不可避免的又需要人工操作的介入，包括数据源的选取，更换；

②在合同明细表打开的情况下邮件合并冲突，影响程序的连续性。

③在后续结果公示、合同文件生成中，因为中标单位的不确定性，会造成数据源不可知的问题。

（2）竞价会议纪要的生成

各竞价单位的报价数据，填入Excel 表对应的报价列中，然后利用循环代码，用以判断最低价以及最低价单位，以确定为中标候选人。

For i=2 To UBound（arr）

If d.exists（arr（i，4））Then

d（arr（i，4））=d（arr（i，4））+1

z=d（arr（i，4））

ReDim Preserve brr（1 To 8，1 To z）

报价=IIf（arr（i，16）＞0，arr（i，16），IIf（arr（i，15）＞0，arr（i，15），arr（i，14）））

brr（1，z）=arr（i，1）:brr（2，z）=报价

If T 报价＞报价Then T 报价= 报价: 拟选定单位= brr（1，z）

Else

d.Add arr（i，4），1

ReDim brr（1 To 8，1 To 1）

报价=IIf（arr（i，16）＞0，arr（i，16），IIf（arr（i，15）＞0，arr（i，15），arr（i，14）））:T 报价=报价

brr（1，1）= arr（i，1）: brr（2，1）= 报价: brr（3，1）= arr（i，12）:brr（4，1）=arr（i，3）:brr（5，1）=arr（i，13）: brr （6，1）=arr（i，17）:brr（7，1）=arr（i，4）

拟选定单位=brr（1，1）

End If

Next i

利用tables.InsertAfter 功能实现对Word 表格数据的写入。

Set odoc = WordApp.Documents.Open（ThisWorkbook.Path &""&"会议记录.doc"）

If odoc.tables.Count ＞=1 Then

For n=1 To brr（8，j）

With odoc.tables（1）.cell（n+1，2）.Range

.Delete

.InsertAfter Text:=brr（1，n）

投标单位=brr（1，n）&"、"&投标单位

End With

With odoc.tables（1）.cell（n+1，3）.Range

.Delete

.InsertAfter Text:=arr（n+1，14）

End With

With odoc.tables（1）.cell（n+1，4）.Range

.Delete

.InsertAfter Text:=brr（2，n）

End With

With odoc.tables（1）.cell（n+1，5）.Range

.Delete

.InsertAfter Text:=Format（arr（n+1，19），"0%"）

End With

Next n

End If

投标单位数量=brr（8，j）

（3）结果公示、中标通知书、合同审批表及合同的生成

以上几个合同文档，完全按照设定的时间节点，去自动生成，不再需要人为干预。其中合同中有关乙方对应开户行账号、税号等信息，也是从名为供应商的Excel 工作表中自动获取；包括合同大写金额的转换，也是通过人民币大写转换函数来自动转换的。生成的同时将结果公示、中标通知书发送至所有竞价单位，将合同文本发送至中标单位。

读取供应商信息：

mrr=Sheets（"供应商"）.Range（"a1"）.CurrentRegion

ReDim nrr（1 To 12，1 To 1）

For w=2 To UBound（mrr）

If mrr（w，1）=成交单位Then

kk=kk+1

ReDim Preserve nrr（1 To 12，1 To kk）

For ww=1 To 12

nrr（ww，kk）=mrr（w，ww）

Next ww

dd.Add arr（w，1），nrr

End If

Next

单位地址=nrr（2，1）

传真=nrr（3，1）

电话=nrr（4，1）

开户银行=nrr（4，1）

账号=nrr（5，1）

税号=nrr（6，1）

大写金额=RMBcase（Replace（成交金额，"元"，""））

税率= Application.WorksheetFunction.VLookup（成交单位，

Sheets（"明细"）.Range（"a1:s"&brr（8，1）+1），19，0）

选择合同文本模版：

选择=Application.InputBox（"请选择现场安装维修还是离线合同？现场安装维修合同输入1，离线合同输入2？"）

If 选择=1 Then

Set odoc = WordApp.Documents.Open（ThisWorkbook.Path &""&"现场安装合同样本1.doc"）

Else

Set odoc = WordApp.Documents.Open（ThisWorkbook.Path &""&"离线设备维修合同样本2.doc"）

End If

写入Word 模版：

With odoc

For Each doc_var In odoc.Variables

doc_var.Delete

Next

.Variables.Add Name:="项目名称"，Value:=项目名称

.Variables.Add Name:="成交单位"，Value:=成交单位

.Variables.Add Name:="单位地址"，Value:=单位地址

.Variables.Add Name:="传真"，Value:=IIf（传真= ""，" "，传真）

.Variables.Add Name:="电话"，Value:=IIf（电话= ""，" "，电话）

.Variables.Add Name:="开户银行"，Value:=开户银行

.Variables.Add Name:="账号"，Value:=账号

.Variables.Add Name:="税号"，Value:=税号

.Variables.Add Name:="成交金额"，Value:=Replace（成交金额，"元"，""）

.Variables.Add Name:="大写金额"，Value:=大写金额

.Variables.Add Name:="税率"，Value:=Format（税率，"0%"）

.Fields.Update

.Fields.Unlink

End With

保存文件：

If Dir（ThisWorkbook.Path & "" & 项目号& ""，vbDirecto⁃ry）= "" Then MkDir（ThisWorkbook.Path & "" & 项目号&""）

odoc.SaveAs ThisWorkbook.Path & "" & 项目号& "" & 项目号&"合同.doc"

合同金额根据中标金额，进行大写转换：

Public Function RMBcase（ByVal Num As Double）As String

Dim s As String，i As Long'英文有Lcase、Ucase，所以人民币

case

s=Application.Text（Format（Num，"0.00"），"[DBNum2]"）

'Format 四舍五入两位小数，[DBNum2]对应"数字格式→特殊→中文大写"

s=Replace（s，"-"，"负"）'替换减号为 负

s=Replace（s，"."，"元"）'替换点为 元

i=Len（s）'字符串长度

Select Case InStr（1，s，"元"，1）'"元"出现的位置

Case 0:If s="零"Then s=""Else s=s&"元整"'无元：整数，零为空，整数为整元

Case i-1:s=s&"角整"'在倒数第2 位，有角位无分位

Case i-2:s=Left（s，i-1）&"角"&Right（s，1）&"分"'在倒数第3 位，有角分位

End Select

s=Replace（s，"零元零角"，""）'在大写中，无零元零角，只有几元零几分

s=Replace（s，"零元"，""）'替换的先后顺序不能乱

RMBcase=Replace（s，"零角"，"零"）

End Function

发送邮件：

Sub SendEmail（To 电子邮箱As String，主题As String，At⁃tachedObject As String）

Dim OutlookObj As Object

Dim OutlookNewMail As Object

'创建Outlook 对象

Set OutlookObj=CreateObject（"Outlook.Application"）

Set OutlookNewMail=OutlookObj.CreateItem（olMailItem）

On Error GoTo SendEmail_Failed

With OutlookNewMail

.To=To 电子邮箱

.Subject=主题

.Attachments.Add AttachedObject'发送附件

.Send

End With

End Sub

以上代码除合同模版样式需根据实际情况做选择外，其他合同文档均实现一键生成、存档功能。同时，各变量也是一次写入，多次调用，复写效率很高。

（4）合同台账的生成

图4 运行界面及效果

表2

合同台账是伴随着明细表中合同文档生成后，自动写入到合同台账表格中的，不需另行复制粘贴，以减少错误的发生。

2 结语

经过多次调试和试验证明，通过以上方法可以方便地利用VBA 实现多文档批量自动生成。该方法操作简单，自动化程度非常高，提高了工作效率和工作质量；同时，生成的明细台账也为今后更好地实现信息化管理提供了解决思路和便利。