用VB和Word来制作格式合同的方法

概述：在应用程序中经常有定制格式报表的需要，如打印合同、货物清单、备忘录等等，使用第三方报表软件可以实现但是比较繁琐，实际上利用Word的自动化编程，使用VBA可以完成类似的功能，而且很实用。

  步骤一、

  word模版制作:

  在第一行是合同标题 " 【书签1合同标题xxxxxxxx合同】"

  第二行
  ******************************

  合同编号: 【书签2合同编号】

  签约单位: 【书签3签约单位】

  签约地址: 【书签4签约地址】
 
  签约日期: 【书签5签约日期】

.  ....

  表格第一行 ''表格第一行第一列中插入 书签4

  表格第二行

  ''实现代码如下

  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