word.frm

vb精彩编程希望大家有用

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   1935
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   3435
   LinkTopic       =   "Form1"
   ScaleHeight     =   1935
   ScaleWidth      =   3435
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command1 
      Caption         =   "生成合同"
      Height          =   495
      Left            =   960
      TabIndex        =   0
      Top             =   480
      Width           =   1215
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
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 Format(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!ISBN
            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

Private Sub Form_Unload(Cancel As Integer)
    Set WordTemps = Nothing
    If cn.State = 1 Then
        cn.Close
    End If
    Set cn = Nothing
End Sub