**调用Word实现计量证书的自动生成**
当前很多计量所相继研发了自己的计量管理系统，但就计量证书的自动生成而言，大多软件都不尽如人意，并且仍有许多计量软件没有证书的自动生成这一模块，而仍沿用传统的用Word手工编辑证书的方法。如何利用业务收发室登记的原始资料灵活而快捷的录入计量检定数据信息是影响实验室检定人员生成证书报告效率的关键因素。
调用业务收发室登记的原始送检信息很容易做到，只需将软件架构在局域网上，后台数据库选用大型关系数据(如SQLServer)即可实现数据的共享。为了做到快捷录入计量检定数据信息，我们在后台建立了检定员表、检定仪器表、检定规程(检定依据)表、检定结果数据模板表等作为生成计量证书的必要参数，供生成证书时选择，从而避免了手工输入。同时为了利用Word手工编辑证书的灵活性，我们在自动生成证书时仍选用了采用Word模板作为证书模板，通过程序调用将相关参数插入到Word模板中，从而实现计量证书的自动生成。程序运行界面如图1、图2所示:
程序代码如下:
PrivateSubcmdCreateReport_Click()
OnErrorResumeNext
DimobjWordAppAsWord.Application
DimobjWordDocAsWord.Document
SetobjWordApp=GetObject(“Word.Application”)
IfobjWordApp=NullThen
SetobjWordApp=CreateObject(“Word.Application”)
EndIf
IfchkNo.Value=1Then
’生成检定结果通知书
SetobjWordDoc=objWordApp.Documents.Open(App.Path&“\Templates\JDTZ.dot”)
objWordDoc.Application.DisplayAlerts=wdAlertsNone
objWordApp.Visible=True
objWordDoc.Bookmarks(“ZSBH”).Range.Text=txtZSBH.Text
objWordDoc.Bookmarks(“SYDW”).Range.Text=txtSYDW.Text
objWordDoc.Bookmarks(“YQMC”).Range.Text=txtYQMC.Text
objWordDoc.Bookmarks(“YQZZS”).Range.Text=txtYQZZS.Text
objWordDoc.Bookmarks(“GGXH”).Range.Text=txtGGXH.Text
objWordDoc.Bookmarks(“ZQD”).Range.Text=txtZQD.Text
objWordDoc.Bookmarks(“YQBH”).Range.Text=txtYQBH.Text
objWordDoc.Bookmarks(“JDYJ”).Range.Text=txtJDYJ.Text
objWordDoc.Bookmarks(“PY”).Range.Text=Year(dtpPZRQ.Value)
objWordDoc.Bookmarks(“PM”).Range.Text=Month(dtpPZRQ.Value)
objWordDoc.Bookmarks(“PD”).Range.Text=Day(dtpPZRQ.Value)
objWordDoc.Bookmarks(“PStdName”).Range.Text=txtPStdName.Text
objWordDoc.Bookmarks(“PStdZSBH”).Range.Text=txtPStdZSBH.Text
objWordDoc.Bookmarks(“PYXQ”).Range.Text=txtPYXQ.Text
objWordDoc.Bookmarks(“WD”).Range.Text=txtWD.Text
objWordDoc.Bookmarks(“SD”).Range.Text=txtSD.Text
objWordDoc.Bookmarks(“Else”).Range.Text=txtElse.Text
objWordDoc.Bookmarks(“JY”).Range.Text=Year(dtpJCSJ.Value)
objWordDoc.Bookmarks(“JM”).Range.Text=Month(dtpJCSJ.Value)
objWordDoc.Bookmarks(“JD”).Range.Text=Day(dtpJCSJ.Value)
objWordDoc.Bookmarks(“ZSBH1”).Range.Text=txtZSBH.Text
’将RichTextBox中的内容全选
rtxtJDJG.SelStart=0
JDJG.SelLength=Len(rtxtJDJG.Text)
’将RichTextBox中的内容全部复制到剪贴板中
SendMessagertxtJDJG.hwnd,WM_COPY,0,ByVal0&
objWordDoc.Bookmarks(“JDJG”).Range.Paste
Else
IfchkPageTh.Value=1Then’三页格式证书
SetobjWordDoc=objWordApp.Documents.Open(App.Path&“\Templates\JDPageTh.dot”)
Else’两页格式证书
SetobjWordDoc=objWordApp.Documents.Open(App.Path&“\Templates\JDPageT.dot”)
EndIf
objWordApp.Visible=True
objWordDoc.Bookmarks(“ZSBH”).Range.Text=txtZSBH.Text
objWordDoc.Bookmarks(“ZSBH1”).Range.Text=txtZSBH.Text
IfchkPageTh.Value=1Then
objWordDoc.Bookmarks(“ZSBH2”).Range.Text=txtZSBH.Text
rtxtJDJGT.SelStart=0
rtxtJDJGT.SelLength=Len(rtxtJDJGT.Text)
’将RichTextBox中的内容全部复制到剪贴板中
SendMessagertxtJDJGT.hwnd,WM_COPY,0,ByVal0&
objWordDoc.Bookmarks(“JDJGT”).Range.Paste
EndIf
objWordDoc.Bookmarks(“SYDW”).Range.Text=txtSYDW.Text
objWordDoc.Bookmarks(“YQMC”).Range.Text=txtYQMC.Text
objWordDoc.Bookmarks(“YQZZS”).Range.Text=txtYQZZS.Text
objWordDoc.Bookmarks(“GGXH”).Range.Text=txtGGXH.Text'
objWordDoc.Bookmarks(“ZQD”).Range.Text=txtZQD.Text
objWordDoc.Bookmarks(“YQBH”).Range.Text=txtYQBH.Text
objWordDoc.Bookmarks(“JDYJ”).Range.Text=txtJDYJ.Text
objWordDoc.Bookmarks(“PStdName”).Range.Text=txtPStdName.Text
objWordDoc.Bookmarks(“PStdZSBH”).Range.Text=txtPStdZSBH.Text
objWordDoc.Bookmarks(“PYXQ”).Range.Text=txtPYXQ.Text
objWordDoc.Bookmarks(“WD”).Range.Text=txtWD.Text
objWordDoc.Bookmarks(“SD”).Range.Text=txtSD.Text
objWordDoc.Bookmarks(“Else”).Range.Text=txtElse.Text
objWordDoc.Bookmarks(“JY”).Range.Text=Year(dtpJCSJ.Value)
objWordDoc.Bookmarks(“JM”).Range.Text=Month(dtpJCSJ.Value)
objWordDoc.Bookmarks(“JD”).Range.Text=Day(dtpJCSJ.Value)
objWordDoc.Bookmarks(“XY”).Range.Text=Year(dtpYXQ.Value)
objWordDoc.Bookmarks(“XM”).Range.Text=Month(dtpYXQ.Value)
objWordDoc.Bookmarks(“XD”).Range.Text=Day(dtpYXQ.Value)
’将RichTextBox中的内容全选
rtxtJDJG.SelStart=0
rtxtJDJG.SelLength=Len(rtxtJDJG.Text)
’将RichTextBox中的内容全部复制到剪贴板中
SendMessagertxtJDJG.hwnd,WM_COPY,0,ByVal0&
objWordDoc.Bookmarks(“JDJG”).Range.Paste
EndIf
IfFileExist(App.Path&“\doc\”&txtJCProjectID.Text&“.doc”)Then
DelDocFileApp.Path&"“doc\”&txtJCProjectID.Text&“.doc”
EndIf
objWordDoc.SaveAsApp.Path&“\doc\”&txtJCProjectID.Text&“.doc”
SetobjWordDoc=Nothing
SetobjWordApp=Nothing
EndSub
**附件**
file:///C:/DOCUME%7E1/ych/LOCALS%7E1/Temp/msohtml1/01/clip_image001.gif图1
[attach]22425[/attach]
file:///C:/DOCUME%7E1/ych/LOCALS%7E1/Temp/msohtml1/01/clip_image001.gif
图2
[attach]22426[/attach]