我正在為小型家族企業(養狗)創建一個 Access 2019 資料庫,因此我設定了一些表格,其中包含有關狗和主人的所有詳細資訊。只是給出一個想法(對情況的簡單描述):
Dogs
Name
Birth
Microchip
Etc…
Owners
Name
Address
Etc…
我現在正在嘗試為我們賣狗時創建一個“合同作曲家”。所以我做了一個新表“合同”和一個相關的表格
Contract
Seller ->linked to Owners table
Buyer ->linked to Owners table
Dog ->linked to Dogs table
Price
并進行查詢以從相關表中提取所有相關資訊,以便我可以擁有
ContractQuery
Seller!Name
Seller!Address
Buyer!Name
Buyer!Address
Dog!Name
Dog!Birthdate
Dog!Microchip
Contract!Price
到目前為止,一切都運行良好。現在我需要將 ContractQuery 欄位轉換為“人類可讀”合同的形式。我認為最好的方法是 MailMerge 到特定的 Word 檔案,我已經設定了一個。我的問題是:如何在合同表單中設定一個按鈕,以便在“contract.doc”中填充我現在在表單中看到的特定記錄?我做了一些研究,我發現最相關的資訊是這個 https://www.access-programmers.co.uk/forums/threads/run-mail-merge-from-vba.158126/ 和這個https: //www.tek-tips.com/faqs.cfm?fid=3237 但它們與舊的 MS-Access 相關,所以當我嘗試應用它時,我到處都是錯誤。不幸的是,我的 VBA 知識遠非精通,我無法使其發揮作用。任何人都可以幫助我,或向我提出解決方案嗎?提前感謝您的任何建議
uj5u.com熱心網友回復:
好的,多虧了 Kostas K,我得到了它,為我指明了戰斗方向。這是我的最終代碼,它可能需要一些清理和調整(例如,結果中的回圈現在是多余的,因為我只有一個結果),但它正在作業:)
解決方案基于這篇文章,如果有人需要,請查看它作為模板 docx 等的參考
使用 word docs 和 ms access 生成完整的 PDF 表單
Option Explicit
Private Sub cmdMergeIt_Click()
On Error GoTo Trap
' **** defining project path as string to make this portable
Dim CurPath As String
CurPath = CurrentProject.path & "\"
' MsgBox (CurPath) 'debug
Dim TEMPLATE_PATH As String
TEMPLATE_PATH = CurPath & "Contratto.dotx"
Dim wApp As Word.Application
Dim wDoc As Word.Document
Dim rs As DAO.Recordset
Dim idx As Long
' *** intercepting the contract ID field from the launching form
Dim checkID As String
checkID = ID.Value
'MsgBox (checkID) 'debug
' **** defining a SQL query on my Access query
Dim strSQL As String
strSQL = "Select * from qContratto where ID =" & checkID & ""
' MsgBox (strSQL) 'debug
Set wApp = New Word.Application
wApp.Visible = False
' ***** changed the OpenRecordset to call my strSQL query insetad than reading the whole Access query
Set rs = CurrentDb.OpenRecordset(strSQL, dbOpenSnapshot)
If rs.EOF Then GoTo Leave
With rs
.MoveLast
.MoveFirst
End With
For idx = 1 To rs.RecordCount
Set wDoc = wApp.Documents.Add(TEMPLATE_PATH)
With wDoc
.Bookmarks("Prezzo").Range.Text = Nz(rs!Prezzo, vbNullString)
.Bookmarks("Venditore").Range.Text = Nz(rs!Venditore, vbNullString)
.Bookmarks("Acquirente").Range.Text = Nz(rs!Acquirente, vbNullString)
.Bookmarks("Cessione").Range.Text = Nz(rs!Cessione, vbNullString)
.Bookmarks("NomeCane").Range.Text = Nz(rs!NomeCane, vbNullString)
.Bookmarks("Riproduzione").Range.Text = Nz(rs!Riproduzione, vbNullString)
.Bookmarks("Sesso").Range.Text = Nz(rs!Sesso, vbNullString)
.ExportAsFixedFormat CurPath & rs!Acquirente & ".pdf", wdExportFormatPDF, False, wdExportOptimizeForOnScreen
.Close wdDoNotSaveChanges
' in the ExportAsFixedFormat here above called one of the SQL query values to make a unique and distinctive name. Also please note use of CurPath for portability
End With
Set wDoc = Nothing
rs.MoveNext
Next
Leave:
On Error Resume Next
If Not rs Is Nothing Then rs.Close
If Not wDoc Is Nothing Then wDoc.Close wdDoNotSaveChanges
If Not wApp Is Nothing Then wApp.Quit wdDoNotSaveChanges
On Error GoTo 0
Exit Sub
Trap:
MsgBox Err.Description, vbCritical
Resume Leave
End Sub
轉載請註明出處,本文鏈接:https://www.uj5u.com/houduan/451413.html
