用VB＋WORD模版＋数据库来制作格式合同的方法（转帖）

用VB＋WORD模版＋数据库来制作格式合同的方法

发表时间：2004-8-10 作者：未知[获得此文档时候没有作者记录，深感抱歉，本文档全为转载]

用VB＋WORD模版＋数据库来制作格式合同的方法   概述：在应用程序中经常有定制格式报表的需要，如打印合同、货物清单、备忘录等等，使用第三方报表软件可以实现但是比较繁琐，实际上利用Word的自动化编程，使用VBA可以完成类似的功能，而且很实用。   步骤一、 word模版制作:   在第一行是合同标题 " 【书签1合同标题xxxxxxxx合同】"   第二行                  ****************************** 合同编号: 【书签2合同编号】 签约单位: 【书签3签约单位】 签约地址: 【书签4签约地址】 签约日期: 【书签5签约日期】 ..... 表格第一行    '表格第一行第一列中插入 书签4 表格第二行 ... 货物名称 数量 规格 【书签6货物清单】         '实现代码如下   Dim cn As New ADODB.Connection Dim AdoRs As New ADODB.Recordset Dim WordTemps As New Word.Application   Private Sub Form_Load()     If cn.State = 1 Then         cn.Close     End If     cn.CursorLocation = adUseClient     cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "/db1.mdb" End Sub   '开始导出数据 Private Sub Command1_Click()     Dim strSQl As String     Dim REC As Integer     Dim i As Integer       WordTemps.Documents.Add App.Path + "/货物合同.doc", False       WordTemps.Selection.GoTo wdGoToBookmark, , , "合同标题"     WordTemps.Selection.TypeText “关于冬季货物的成交合同”                    WordTemps.Selection.GoTo wdGoToBookmark, , , "合同编号"     WordTemps.Selection.TypeText “2004000001”       WordTemps.Selection.GoTo wdGoToBookmark, , , "签约单位"     WordTemps.Selection.TypeText “宏大科技公司，天天科技公司”       WordTemps.Selection.GoTo wdGoToBookmark, , , "签约地址"     WordTemps.Selection.TypeText “北京中关村大厦”         WordTemps.Selection.GoTo wdGoToBookmark, , , "签约时间"     WordTemps.Selection.TypeText fromat(Now, "yyyy-mm-dd")       strSQl = "select * from Matrixs"     AdoRs.Open strSQl, cn, adOpenKeyset, adLockOptimistic     REC = AdoRs.RecordCount         If REC < 1 Then         MsgBox "无商品记录！", vbOKOnly, "提示"         AdoRs.Close         Exit Sub     Else         AdoRs.MoveFirst WordTemps.Selection.GoTo wdGoToBookmark, , , "货物清单"           For i = 1 To REC                         WordTemps.Selection.TypeText AdoRs!名称             WordTemps.Selection.MoveRight unit:=wdCharacter, Count:=1 '右移一格             WordTemps.Selection.TypeText AdoRs!数量             WordTemps.Selection.MoveRight unit:=wdCharacter, Count:=1 '右移一格             WordTemps.Selection.TypeText AdoRs!规格                         AdoRs.MoveNext             If AdoRs.EOF = False Then                 WordTemps.Selection.InsertRowsBelow 1     '表格换行             End If         Next i                                 AdoRs.Close                     WordTemps.Visible = True '显示WORD窗口       End If   End Sub   作者：soho_andy(冰)   中国.Net俱乐部转载此文。让我们一起进步，共享人类技术资源。[www.chinaaspx.com]