當前很多計量所相繼研發了自己的計量管理系統，但就計量證書的自動生成而言，大多軟件都不盡如人意，并且仍有許多計量軟件沒有證書的自動生成這一模塊，而仍沿用傳統的用Word手工編輯證書的方法。如何利用業務收發室登記的原始資料靈活而快捷的錄入計量檢定數據信息是影響實驗室檢定人員生成證書報告效率的關鍵因素。
調用業務收發室登記的原始送檢信息很容易做到，只需將軟件架構在局域網上，后臺數據庫選用大型關系數據(如SQL Server)即可實現數據的共享。為了做到快捷錄入計量檢定數據信息，我們在后臺建立了檢定員表、檢定儀器表、檢定規程(檢定依據)表、檢定結果數據模板表等作為生成計量證書的必要參數，供生成證書時選擇，從而避免了手工輸入。同時為了利用Word手工編輯證書的靈活性，我們在自動生成證書時仍選用了采用Word模板作為證書模板，通過程序調用將相關參數插入到Word模板中，從而實現計量證書的自動生成。程序運行界面如圖1、圖2所示:
程序代碼如下:
Private Sub cmdCreateReport_Click()
On Error Resume Next
Dim objWordApp As Word.Application
Dim objWordDoc As Word.Document
Set objWordApp = GetObject(“Word.Application”)
If objWordApp = Null Then
Set objWordApp = CreateObject(“Word.Application”)
End If
If chkNo.Value = 1 Then
’生成檢定結果通知書
Set objWordDoc = 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中的內容全部復制到剪貼板中
SendMessage rtxtJDJG.hwnd, WM_COPY, 0, ByVal 0&
objWordDoc.Bookmarks(“JDJG”).Range.Paste
Else
If chkPageTh.Value = 1 Then ’三頁格式證書
Set objWordDoc = objWordApp.Documents.Open(App.Path & “\Templates\JDPageTh.dot”)
Else ’兩頁格式證書
Set objWordDoc = objWordApp.Documents.Open(App.Path & “\Templates\JDPageT.dot”)
End If
objWordApp.Visible = True
objWordDoc.Bookmarks(“ZSBH”).Range.Text = txtZSBH.Text
objWordDoc.Bookmarks(“ZSBH1”).Range.Text = txtZSBH.Text
If chkPageTh.Value = 1 Then
objWordDoc.Bookmarks(“ZSBH2”).Range.Text = txtZSBH.Text
rtxtJDJGT.SelStart = 0
rtxtJDJGT.SelLength = Len(rtxtJDJGT.Text)
’將RichTextBox中的內容全部復制到剪貼板中
SendMessage rtxtJDJGT.hwnd, WM_COPY, 0, ByVal 0&
objWordDoc.Bookmarks(“JDJGT”).Range.Paste
End If
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中的內容全部復制到剪貼板中
SendMessage rtxtJDJG.hwnd, WM_COPY, 0, ByVal 0&
objWordDoc.Bookmarks(“JDJG”).Range.Paste
End If
If FileExist(App.Path &“\doc\” & txtJCProjectID.Text &“.doc”) Then
DelDocFile App.Path &"“doc\”& txtJCProjectID.Text &“.doc”
End If
objWordDoc.SaveAs App.Path &“\doc\”& txtJCProjectID.Text &“.doc”
Set objWordDoc=Nothing
Set objWordApp=Nothing
End Sub |
評分
-
查看全部評分
|
收藏
贊
踩
閩公網安備 35020602000072號