VB如何将数据导入WORD模版打印

以前做的一个单据外观小程序，客户可以编辑word模版改变单据的样式，废话不说了，直接上图和代码：http://leek.woku.com/article/4876141.html

Public Sub ExporToWord2003()

On Error GoTo DocERR

'************************************************************************************
Dim Rs As New ADODB.Recordset
Dim strSQL As String

If Len(TextNumber.Text) <> 0 Then
'*使用自定义寻找表单号
If Len(TextNumber.Text) <> 12 Then
MsgBox "输入的表单号应该是12个数字字符",vbInformation
GoTo PROC_EXIT
End If
strSQL = "SELECT * FROM 记录 WHERE 记录号 = " & _
QueryStrToSQLstr(TextNumber.Text) & " ORDER BY ID"
Set Rs = ExecuteSQL(strSQL)
If Rs.RecordCount <> 1 Then
MsgBox "输入表单号错误！",vbExclamation

Rs.Close
Set Rs = Nothing

GoTo PROC_EXIT

End If
Else
strSQL = "SELECT * FROM 记录 ORDER BY ID"
Set Rs = ExecuteSQL(strSQL)
Rs.MoveLast
End If


'************************************************************************************

Label3.Caption = "加载模板，请稍候......"

'建立Word应用程序
Set WordAppX = New Word.Application
'建立Word文档，以当前目录下的Authors.dot为模板
Set WordDocX = WordAppX.Documents.Add(App.Path & "/Authors.dot")


'*不必保存文件
'WordAppX.DisplayAlerts = wdAlertsNone


'获得表格
'*表格索引（1）
Set WordTableX = WordDocX.Tables(1)
'*显示WORD
WordAppX.Visible = Check1.Value

WordTableX.Cell(1,1).Range.InsertAfter strNO_Null(Rs("用户住址"))
WordTableX.Cell(1,2).Range.InsertAfter strNO_Null(Rs("用户姓名"))

WordTableX.Cell(3,3).Range.InsertAfter strNO_Null(Rs("水表1底数"))
WordTableX.Cell(3,4).Range.InsertAfter strNO_Null(Rs("水表1底数") - Rs("表1量"))
WordTableX.Cell(3,5).Range.InsertAfter strNO_Null(Rs("表1量"))
WordTableX.Cell(3,6).Range.InsertBefore Trim(Format(Rs("表1价"),"###0.00")) & "/吨"

Dim curWater As Currency

curWater = Rs("表1量") * Rs("表1价")
WordTableX.Cell(4,7).Range.InsertBefore GetOneNum(curWater,1)
WordTableX.Cell(4,8).Range.InsertBefore GetOneNum(curWater,2)
WordTableX.Cell(4,9).Range.InsertBefore GetOneNum(curWater,3)
WordTableX.Cell(4,10).Range.InsertBefore GetOneNum(curWater,4)
WordTableX.Cell(4,11).Range.InsertBefore GetOneNum(curWater,6)
WordTableX.Cell(4,12).Range.InsertBefore GetOneNum(curWater,7)


WordTableX.Cell(5,3).Range.InsertAfter Rs("水表2底数")
WordTableX.Cell(5,4).Range.InsertAfter Rs("水表2底数") - Rs("表2量")
WordTableX.Cell(5,5).Range.InsertAfter Rs("表2量")
WordTableX.Cell(5,6).Range.InsertBefore Trim(Format(Rs("表2价"),"###0.00")) & "/吨"

curWater = Rs("表2量") * Rs("表2价")
WordTableX.Cell(5,1)
WordTableX.Cell(5,2)
WordTableX.Cell(5,3)
WordTableX.Cell(5,4)
WordTableX.Cell(5,6)
WordTableX.Cell(5,7)

WordTableX.Cell(6,4).Range.InsertAfter Rs("本次购电量")
WordTableX.Cell(6,5).Range.InsertAfter Trim(Format(Rs("每度电单价"),"###0.00")) & "/度"

curWater = Rs("本次购电量") * Rs("每度电单价")
WordTableX.Cell(6,6).Range.InsertBefore GetOneNum(curWater,1)
WordTableX.Cell(6,2)
WordTableX.Cell(6,3)
WordTableX.Cell(6,4)
WordTableX.Cell(6,6)
WordTableX.Cell(6,7)

curWater = Rs("管理服务费")
WordTableX.Cell(7,1)
WordTableX.Cell(7,2)
WordTableX.Cell(7,3)
WordTableX.Cell(7,4)
WordTableX.Cell(7,6)
WordTableX.Cell(7,7)

curWater = Rs("住房维修费")
WordTableX.Cell(8,1)
WordTableX.Cell(8,2)
WordTableX.Cell(8,3)
WordTableX.Cell(8,4)
WordTableX.Cell(8,6)
WordTableX.Cell(8,7)

curWater = Rs("应交")
WordTableX.Cell(9,2).Range.InsertBefore ChMoney(curWater)

WordTableX.Cell(9,3).Range.InsertBefore GetOneNum(curWater,1)
WordTableX.Cell(9,4).Range.InsertBefore GetOneNum(curWater,2)
WordTableX.Cell(9,5).Range.InsertBefore GetOneNum(curWater,3)
WordTableX.Cell(9,4)
WordTableX.Cell(9,6)
WordTableX.Cell(9,7)

WordTableX.Cell(3,13).Range.InsertBefore "单据号：" & strNO_Null(Rs("记录号")) & _
" 日期：" & DateToChina(Rs("收费日期")) & _
" 收费员：" & strNO_Null(Rs("售电员"))

' 行 列
'WordTableX.Cell(4,2).Range.InsertAfter "用户编号"

'****************************************************
'*关闭数据集
Rs.Close
Set Rs = Nothing
'****************************************************

If Check1.Value = 0 Then

'*直接打印
WordAppX.PrintOut

'*等待打印完成后退出
'*程序关闭WORD 释放内存
Timer1.Interval = 5000
Timer1.Enabled = True
Else
'打印预览
WordDocX.PrintPreview
WordAppX.DisplayAlerts = False
'*手动关闭WORD
Set WordAppX = Nothing '交还控制给Word
Set WordDocX = Nothing
Set WordTableX = Nothing

'*显示消息
Label3.Caption = "系统就绪..."
End If

PROC_EXIT:
Exit Sub

ConnectionERR:
'错误处理程序
MsgBox "数据库连接错误，" & Err.Description,vbCritical,"出错"
GoTo PROC_EXIT

RecordSetERR:
MsgBox "RecordSet生成错误，" & Err.Description,"出错"
GoTo PROC_EXIT

DocERR:
MsgBox "填充Word表格错误，" & Err.Description,"出错"
If Not WordAppX Is Nothing Then WordAppX.Quit

GoTo PROC_EXIT

End Sub