If this is your first visit, be sure to check out the FAQ by clicking the link above. You may have to register before you can post: click the register link above to proceed. To start viewing messages, select the forum that you want to visit from the selection below. |
|
|
|
Thread Tools | Display Modes |
#11
|
|||
|
|||
Copy Data From an ACCESS form to a WORD Template
Everyone please note that Aaron Kem.pf is attempting to impersonate one of
our regular posters again. Tom would never post such a message. HTH. Gunny See http://www.QBuilt.com for all your database needs. See http://www.Access.QBuilt.com for Microsoft Access tips and tutorials. Blogs: www.DataDevilDog.BlogSpot.com, www.DatabaseTips.BlogSpot.com http://www.Access.QBuilt.com/html/ex...ributors2.html for contact info. "Tom Wickerath MDB" wrote in message ... wtf, why would you link to SQL Server you should be using Access Data Projects and you should be using REPORTS isntead of word how did you make it through medical school? have yuo always been this much of a dumb****? FILE, NEW, PROJECT EXISTING DATA spit on anyone still using jet for anything "Doctorjones_md" wrote in message ... I have a Front-End ACCESS db (linked to (3) Tables on a Back-End SQL Server). I have a series of Queries that manipulate the data and populate an ACCESS Form. This Form has the following features: 1. A Main Form, with several pages (Tabs) which display data from one (OverallData) Table a. One of these pages (Tabs) contains a Sub-Form which displays data from another (SpecificData) Table Here's my quandry ... I'm trying to display (in the WORD template) a field from the Sub-Form -- how do I modify the code-syntax to accomplish this? Example: .FormFields("fldDeliveryFee").result = Nz(Me!DeliveryFee) NOW: I want to include "GrossPurchaseTotal" from the Sub-Form (which is populated from a seperate table) -- what do I need to modify to accomplish this? I have the following code which I use to display the data (via Text Form Fields) in my WORD document: ====================================== Option Compare Database Option Explicit Dim path As String Const DOC_PATH1 As String = "\\Fileserver\Products\ " Const DOC_NAME1 As String = _ "Products1.dot" Const DOC_PATH2 As String = "\\Fileserver\Products\ " Const DOC_NAME2 As String = _ " Products2.dot " Const DOC_PATH3 As String = "\\Fileserver\Products\ " Const DOC_NAME3 As String = _ " Products3.dot " Private Sub AddPicture_Click() ' Use the Office File Open dialog to get a file name to use ' as an employee picture. getFileName End Sub Private Sub cmdPrint Products1_Click() Dim appWord As Word.Application Dim doc As Word.Document Dim rst As ADODB.Recordset Dim strSQL As String Dim strReportsTo As String On Error Resume Next Set appWord = GetObject(, "Word.application") If Err = 429 Then Set appWord = New Word.Application Err = 0 End If With appWord Set doc = .Documents(DOC_NAME1) If Err = 0 Then If MsgBox("Do you want to save the current document " _ & "before updating the data?", vbYesNo) = vbYes Then .Dialogs(wdDialogFileSaveAs).Show End If doc.Close False End If On Error GoTo ErrorHandler Set doc = .Documents.Open(DOC_PATH1 & DOC_NAME1, , True) Set rst = New ADODB.Recordset strSQL = "SELECT * FROM PRODUCTS" rst.Open strSQL, CurrentProject.Connection, _ adOpenStatic, adLockReadOnly If Not rst.EOF Then strReportsTo = Nz(rst.Fields(0).Value) rst.Close End If With doc .FormFields("fldCompanyName").result = Nz(Me!CompanyName) .FormFields("fldAddress1").result = Nz(Me!Address1) .FormFields("fldAddress2").result = Nz(Me!Address2) .FormFields("fldCity").result = Nz(Me!City) .FormFields("fldRegion").result = Nz(Me!Region) .FormFields("fldPostalCode").result = Nz(Me!PostalCode) .FormFields("fldProductName").result = Nz(Me!ProductName) .FormFields("fldQty").result = Nz(Me!Qty) .FormFields("fldPrice").result = Nz(Me!Price) .FormFields("fldDeliveryFee").result = Nz(Me!DeliveryFee) End With .Visible = True .Activate End With Set rst = Nothing Set doc = Nothing Set appWord = Nothing Exit Sub ErrorHandler: MsgBox Err & Err.Description End Sub Private Sub cmdPrintProducts2 _Click() Dim appWord As Word.Application Dim doc As Word.Document Dim rst As ADODB.Recordset Dim strSQL As String Dim strReportsTo As String On Error Resume Next Set appWord = GetObject(, "Word.application") If Err = 429 Then Set appWord = New Word.Application Err = 0 End If With appWord Set doc = .Documents(DOC_NAME2) If Err = 0 Then If MsgBox("Do you want to save the current document " _ & "before updating the data?", vbYesNo) = vbYes Then .Dialogs(wdDialogFileSaveAs).Show End If doc.Close False End If On Error GoTo ErrorHandler Set doc = .Documents.Open(DOC_PATH2 & DOC_NAME2, , True) Set rst = New ADODB.Recordset strSQL = "SELECT * FROM PRODUCTS" rst.Open strSQL, CurrentProject.Connection, _ adOpenStatic, adLockReadOnly If Not rst.EOF Then strReportsTo = Nz(rst.Fields(0).Value) rst.Close End If With doc .FormFields("fldCompanyName").result = Nz(Me!CompanyName) .FormFields("fldAddress1").result = Nz(Me!Address1) .FormFields("fldAddress2").result = Nz(Me!Address2) .FormFields("fldCity").result = Nz(Me!City) .FormFields("fldRegion").result = Nz(Me!Region) .FormFields("fldPostalCode").result = Nz(Me!PostalCode) .FormFields("fldProductName").result = Nz(Me!ProductName) .FormFields("fldQty").result = Nz(Me!Qty) .FormFields("fldPrice").result = Nz(Me!Price) .FormFields("fldDeliveryFee").result = Nz(Me!DeliveryFee) End With .Visible = True .Activate End With Set rst = Nothing Set doc = Nothing Set appWord = Nothing Exit Sub ErrorHandler: MsgBox Err & Err.Description End Sub Private Sub cmdPrintProducts3_Click() Dim appWord As Word.Application Dim doc As Word.Document Dim rst As ADODB.Recordset Dim strSQL As String Dim strReportsTo As String On Error Resume Next Set appWord = GetObject(, "Word.application") If Err = 429 Then Set appWord = New Word.Application Err = 0 End If With appWord Set doc = .Documents(DOC_NAME3) If Err = 0 Then If MsgBox("Do you want to save the current document " _ & "before updating the data?", vbYesNo) = vbYes Then .Dialogs(wdDialogFileSaveAs).Show End If doc.Close False End If On Error GoTo ErrorHandler Set doc = .Documents.Open(DOC_PATH3 & DOC_NAME3, , True) Set rst = New ADODB.Recordset strSQL = "SELECT * FROM PRODUCTS" rst.Open strSQL, CurrentProject.Connection, _ adOpenStatic, adLockReadOnly If Not rst.EOF Then strReportsTo = Nz(rst.Fields(0).Value) rst.Close End If With doc .FormFields("fldCompanyName").result = Nz(Me!CompanyName) .FormFields("fldAddress1").result = Nz(Me!Address1) .FormFields("fldAddress2").result = Nz(Me!Address2) .FormFields("fldCity").result = Nz(Me!City) .FormFields("fldRegion").result = Nz(Me!Region) .FormFields("fldPostalCode").result = Nz(Me!PostalCode) .FormFields("fldProductName").result = Nz(Me!ProductName) .FormFields("fldQty").result = Nz(Me!Qty) .FormFields("fldPrice").result = Nz(Me!Price) .FormFields("fldDeliveryFee").result = Nz(Me!DeliveryFee) End With .Visible = True .Activate End With Set rst = Nothing Set doc = Nothing Set appWord = Nothing Exit Sub ErrorHandler: MsgBox Err & Err.Description End Sub ================================================== ============== The REST of the code is deleted for ease-of-viewing ================================================== ============== Private Sub Form_RecordExit(Cancel As Integer) ' Hide the errormsg label to reduce flashing when navigating ' between records. errormsg.Visible = False End Sub Private Sub RemovePicture_Click() ' Clear the file name for the employee record and display the ' errormsg label. Me![ImagePath] = "" hideImageFrame errormsg.Visible = True End Sub Private Sub Form_AfterUpdate() ' Requery the ReportsTo combo box after a record has been changed. ' Then, either show the errormsg label if no file name exists for ' the employee record or display the image if there is a file name that ' exists. 'Me!ReportsTo.Requery On Error Resume Next showErrorMessage showImageFrame If (IsRelative(Me!ImagePath) = True) Then Me![ImageFrame].Picture = path & Me![ImagePath] Else Me![ImageFrame].Picture = Me![ImagePath] End If End Sub Private Sub ImagePath_AfterUpdate() ' After selecting an image for the employee, display it. On Error Resume Next showErrorMessage showImageFrame If (IsRelative(Me!ImagePath) = True) Then Me![ImageFrame].Picture = path & Me![ImagePath] Else Me![ImageFrame].Picture = Me![ImagePath] End If End Sub Private Sub Form_Current() ' Display the picture for the current employee record if the image ' exists. If the file name no longer exists or the file name was blank ' for the current employee, set the errormsg label caption to the ' appropriate message. Dim res As Boolean Dim fName As String path = CurrentProject.path On Error Resume Next errormsg.Visible = False If Not IsNull(Me!Photo) Then res = IsRelative(Me!Photo) fName = Me![ImagePath] If (res = True) Then fName = path & "\" & fName End If Me![ImageFrame].Picture = fName showImageFrame Me.PaintPalette = Me![ImageFrame].ObjectPalette If (Me![ImageFrame].Picture fName) Then hideImageFrame errormsg.Caption = "Picture not found" errormsg.Visible = True End If Else hideImageFrame errormsg.Caption = "Click Add/Change to add picture" errormsg.Visible = True End If End Sub Sub getFileName() ' Displays the Office File Open dialog to choose a file name ' for the current employee record. If the user selects a file ' display it in the image control. Dim fileName As String Dim result As Integer With Application.FileDialog(msoFileDialogFilePicker) .Title = "Select Employee Picture" .Filters.Add "All Files", "*.*" .Filters.Add "JPEGs", "*.jpg" .Filters.Add "Bitmaps", "*.bmp" .FilterIndex = 3 .AllowMultiSelect = False .InitialFileName = CurrentProject.path result = .Show If (result 0) Then fileName = Trim(.SelectedItems.Item(1)) Me![ImagePath].Visible = True Me![ImagePath].SetFocus Me![ImagePath].Text = fileName Me![FirstName].SetFocus Me![ImagePath].Visible = False End If End With End Sub Sub showErrorMessage() ' Display the errormsg label if the image file is not available. If Not IsNull(Me!Photo) Then errormsg.Visible = False Else errormsg.Visible = True End If End Sub Function IsRelative(fName As String) As Boolean ' Return false if the file name contains a drive or UNC path IsRelative = (InStr(1, fName, ":") = 0) And (InStr(1, fName, "\\") = 0) End Function Sub hideImageFrame() ' Hide the image control Me![ImageFrame].Visible = False End Sub Sub showImageFrame() ' Display the image control Me![ImageFrame].Visible = True End Sub |
#12
|
|||
|
|||
Copy Data From an ACCESS form to a WORD Template
Please note that this post is from Aar.on Kem.pff, a known troll.
-- Doug Steele, Microsoft Access MVP http://I.Am/DougSteele (no e-mails, please!) "Tom Wickerath MDB" wrote in message ... wtf, why would you link to SQL Server you should be using Access Data Projects and you should be using REPORTS isntead of word how did you make it through medical school? have yuo always been this much of a dumb****? FILE, NEW, PROJECT EXISTING DATA spit on anyone still using jet for anything "Doctorjones_md" wrote in message ... I have a Front-End ACCESS db (linked to (3) Tables on a Back-End SQL Server). I have a series of Queries that manipulate the data and populate an ACCESS Form. This Form has the following features: 1. A Main Form, with several pages (Tabs) which display data from one (OverallData) Table a. One of these pages (Tabs) contains a Sub-Form which displays data from another (SpecificData) Table Here's my quandry ... I'm trying to display (in the WORD template) a field from the Sub-Form -- how do I modify the code-syntax to accomplish this? Example: .FormFields("fldDeliveryFee").result = Nz(Me!DeliveryFee) NOW: I want to include "GrossPurchaseTotal" from the Sub-Form (which is populated from a seperate table) -- what do I need to modify to accomplish this? I have the following code which I use to display the data (via Text Form Fields) in my WORD document: ====================================== Option Compare Database Option Explicit Dim path As String Const DOC_PATH1 As String = "\\Fileserver\Products\ " Const DOC_NAME1 As String = _ "Products1.dot" Const DOC_PATH2 As String = "\\Fileserver\Products\ " Const DOC_NAME2 As String = _ " Products2.dot " Const DOC_PATH3 As String = "\\Fileserver\Products\ " Const DOC_NAME3 As String = _ " Products3.dot " Private Sub AddPicture_Click() ' Use the Office File Open dialog to get a file name to use ' as an employee picture. getFileName End Sub Private Sub cmdPrint Products1_Click() Dim appWord As Word.Application Dim doc As Word.Document Dim rst As ADODB.Recordset Dim strSQL As String Dim strReportsTo As String On Error Resume Next Set appWord = GetObject(, "Word.application") If Err = 429 Then Set appWord = New Word.Application Err = 0 End If With appWord Set doc = .Documents(DOC_NAME1) If Err = 0 Then If MsgBox("Do you want to save the current document " _ & "before updating the data?", vbYesNo) = vbYes Then .Dialogs(wdDialogFileSaveAs).Show End If doc.Close False End If On Error GoTo ErrorHandler Set doc = .Documents.Open(DOC_PATH1 & DOC_NAME1, , True) Set rst = New ADODB.Recordset strSQL = "SELECT * FROM PRODUCTS" rst.Open strSQL, CurrentProject.Connection, _ adOpenStatic, adLockReadOnly If Not rst.EOF Then strReportsTo = Nz(rst.Fields(0).Value) rst.Close End If With doc .FormFields("fldCompanyName").result = Nz(Me!CompanyName) .FormFields("fldAddress1").result = Nz(Me!Address1) .FormFields("fldAddress2").result = Nz(Me!Address2) .FormFields("fldCity").result = Nz(Me!City) .FormFields("fldRegion").result = Nz(Me!Region) .FormFields("fldPostalCode").result = Nz(Me!PostalCode) .FormFields("fldProductName").result = Nz(Me!ProductName) .FormFields("fldQty").result = Nz(Me!Qty) .FormFields("fldPrice").result = Nz(Me!Price) .FormFields("fldDeliveryFee").result = Nz(Me!DeliveryFee) End With .Visible = True .Activate End With Set rst = Nothing Set doc = Nothing Set appWord = Nothing Exit Sub ErrorHandler: MsgBox Err & Err.Description End Sub Private Sub cmdPrintProducts2 _Click() Dim appWord As Word.Application Dim doc As Word.Document Dim rst As ADODB.Recordset Dim strSQL As String Dim strReportsTo As String On Error Resume Next Set appWord = GetObject(, "Word.application") If Err = 429 Then Set appWord = New Word.Application Err = 0 End If With appWord Set doc = .Documents(DOC_NAME2) If Err = 0 Then If MsgBox("Do you want to save the current document " _ & "before updating the data?", vbYesNo) = vbYes Then .Dialogs(wdDialogFileSaveAs).Show End If doc.Close False End If On Error GoTo ErrorHandler Set doc = .Documents.Open(DOC_PATH2 & DOC_NAME2, , True) Set rst = New ADODB.Recordset strSQL = "SELECT * FROM PRODUCTS" rst.Open strSQL, CurrentProject.Connection, _ adOpenStatic, adLockReadOnly If Not rst.EOF Then strReportsTo = Nz(rst.Fields(0).Value) rst.Close End If With doc .FormFields("fldCompanyName").result = Nz(Me!CompanyName) .FormFields("fldAddress1").result = Nz(Me!Address1) .FormFields("fldAddress2").result = Nz(Me!Address2) .FormFields("fldCity").result = Nz(Me!City) .FormFields("fldRegion").result = Nz(Me!Region) .FormFields("fldPostalCode").result = Nz(Me!PostalCode) .FormFields("fldProductName").result = Nz(Me!ProductName) .FormFields("fldQty").result = Nz(Me!Qty) .FormFields("fldPrice").result = Nz(Me!Price) .FormFields("fldDeliveryFee").result = Nz(Me!DeliveryFee) End With .Visible = True .Activate End With Set rst = Nothing Set doc = Nothing Set appWord = Nothing Exit Sub ErrorHandler: MsgBox Err & Err.Description End Sub Private Sub cmdPrintProducts3_Click() Dim appWord As Word.Application Dim doc As Word.Document Dim rst As ADODB.Recordset Dim strSQL As String Dim strReportsTo As String On Error Resume Next Set appWord = GetObject(, "Word.application") If Err = 429 Then Set appWord = New Word.Application Err = 0 End If With appWord Set doc = .Documents(DOC_NAME3) If Err = 0 Then If MsgBox("Do you want to save the current document " _ & "before updating the data?", vbYesNo) = vbYes Then .Dialogs(wdDialogFileSaveAs).Show End If doc.Close False End If On Error GoTo ErrorHandler Set doc = .Documents.Open(DOC_PATH3 & DOC_NAME3, , True) Set rst = New ADODB.Recordset strSQL = "SELECT * FROM PRODUCTS" rst.Open strSQL, CurrentProject.Connection, _ adOpenStatic, adLockReadOnly If Not rst.EOF Then strReportsTo = Nz(rst.Fields(0).Value) rst.Close End If With doc .FormFields("fldCompanyName").result = Nz(Me!CompanyName) .FormFields("fldAddress1").result = Nz(Me!Address1) .FormFields("fldAddress2").result = Nz(Me!Address2) .FormFields("fldCity").result = Nz(Me!City) .FormFields("fldRegion").result = Nz(Me!Region) .FormFields("fldPostalCode").result = Nz(Me!PostalCode) .FormFields("fldProductName").result = Nz(Me!ProductName) .FormFields("fldQty").result = Nz(Me!Qty) .FormFields("fldPrice").result = Nz(Me!Price) .FormFields("fldDeliveryFee").result = Nz(Me!DeliveryFee) End With .Visible = True .Activate End With Set rst = Nothing Set doc = Nothing Set appWord = Nothing Exit Sub ErrorHandler: MsgBox Err & Err.Description End Sub ================================================== ============== The REST of the code is deleted for ease-of-viewing ================================================== ============== Private Sub Form_RecordExit(Cancel As Integer) ' Hide the errormsg label to reduce flashing when navigating ' between records. errormsg.Visible = False End Sub Private Sub RemovePicture_Click() ' Clear the file name for the employee record and display the ' errormsg label. Me![ImagePath] = "" hideImageFrame errormsg.Visible = True End Sub Private Sub Form_AfterUpdate() ' Requery the ReportsTo combo box after a record has been changed. ' Then, either show the errormsg label if no file name exists for ' the employee record or display the image if there is a file name that ' exists. 'Me!ReportsTo.Requery On Error Resume Next showErrorMessage showImageFrame If (IsRelative(Me!ImagePath) = True) Then Me![ImageFrame].Picture = path & Me![ImagePath] Else Me![ImageFrame].Picture = Me![ImagePath] End If End Sub Private Sub ImagePath_AfterUpdate() ' After selecting an image for the employee, display it. On Error Resume Next showErrorMessage showImageFrame If (IsRelative(Me!ImagePath) = True) Then Me![ImageFrame].Picture = path & Me![ImagePath] Else Me![ImageFrame].Picture = Me![ImagePath] End If End Sub Private Sub Form_Current() ' Display the picture for the current employee record if the image ' exists. If the file name no longer exists or the file name was blank ' for the current employee, set the errormsg label caption to the ' appropriate message. Dim res As Boolean Dim fName As String path = CurrentProject.path On Error Resume Next errormsg.Visible = False If Not IsNull(Me!Photo) Then res = IsRelative(Me!Photo) fName = Me![ImagePath] If (res = True) Then fName = path & "\" & fName End If Me![ImageFrame].Picture = fName showImageFrame Me.PaintPalette = Me![ImageFrame].ObjectPalette If (Me![ImageFrame].Picture fName) Then hideImageFrame errormsg.Caption = "Picture not found" errormsg.Visible = True End If Else hideImageFrame errormsg.Caption = "Click Add/Change to add picture" errormsg.Visible = True End If End Sub Sub getFileName() ' Displays the Office File Open dialog to choose a file name ' for the current employee record. If the user selects a file ' display it in the image control. Dim fileName As String Dim result As Integer With Application.FileDialog(msoFileDialogFilePicker) .Title = "Select Employee Picture" .Filters.Add "All Files", "*.*" .Filters.Add "JPEGs", "*.jpg" .Filters.Add "Bitmaps", "*.bmp" .FilterIndex = 3 .AllowMultiSelect = False .InitialFileName = CurrentProject.path result = .Show If (result 0) Then fileName = Trim(.SelectedItems.Item(1)) Me![ImagePath].Visible = True Me![ImagePath].SetFocus Me![ImagePath].Text = fileName Me![FirstName].SetFocus Me![ImagePath].Visible = False End If End With End Sub Sub showErrorMessage() ' Display the errormsg label if the image file is not available. If Not IsNull(Me!Photo) Then errormsg.Visible = False Else errormsg.Visible = True End If End Sub Function IsRelative(fName As String) As Boolean ' Return false if the file name contains a drive or UNC path IsRelative = (InStr(1, fName, ":") = 0) And (InStr(1, fName, "\\") = 0) End Function Sub hideImageFrame() ' Hide the image control Me![ImageFrame].Visible = False End Sub Sub showImageFrame() ' Display the image control Me![ImageFrame].Visible = True End Sub |
#13
|
|||
|
|||
Copy Data From an ACCESS form to a WORD Template
I appreciate the explanation (and concern) Doug and 69 -- thanks.
"Douglas J. Steele" wrote in message ... Please note that this post is from Aar.on Kem.pff, a known troll. -- Doug Steele, Microsoft Access MVP http://I.Am/DougSteele (no e-mails, please!) "Tom Wickerath MDB" wrote in message ... wtf, why would you link to SQL Server you should be using Access Data Projects and you should be using REPORTS isntead of word how did you make it through medical school? have yuo always been this much of a dumb****? FILE, NEW, PROJECT EXISTING DATA spit on anyone still using jet for anything "Doctorjones_md" wrote in message ... I have a Front-End ACCESS db (linked to (3) Tables on a Back-End SQL Server). I have a series of Queries that manipulate the data and populate an ACCESS Form. This Form has the following features: 1. A Main Form, with several pages (Tabs) which display data from one (OverallData) Table a. One of these pages (Tabs) contains a Sub-Form which displays data from another (SpecificData) Table Here's my quandry ... I'm trying to display (in the WORD template) a field from the Sub-Form -- how do I modify the code-syntax to accomplish this? Example: .FormFields("fldDeliveryFee").result = Nz(Me!DeliveryFee) NOW: I want to include "GrossPurchaseTotal" from the Sub-Form (which is populated from a seperate table) -- what do I need to modify to accomplish this? I have the following code which I use to display the data (via Text Form Fields) in my WORD document: ====================================== Option Compare Database Option Explicit Dim path As String Const DOC_PATH1 As String = "\\Fileserver\Products\ " Const DOC_NAME1 As String = _ "Products1.dot" Const DOC_PATH2 As String = "\\Fileserver\Products\ " Const DOC_NAME2 As String = _ " Products2.dot " Const DOC_PATH3 As String = "\\Fileserver\Products\ " Const DOC_NAME3 As String = _ " Products3.dot " Private Sub AddPicture_Click() ' Use the Office File Open dialog to get a file name to use ' as an employee picture. getFileName End Sub Private Sub cmdPrint Products1_Click() Dim appWord As Word.Application Dim doc As Word.Document Dim rst As ADODB.Recordset Dim strSQL As String Dim strReportsTo As String On Error Resume Next Set appWord = GetObject(, "Word.application") If Err = 429 Then Set appWord = New Word.Application Err = 0 End If With appWord Set doc = .Documents(DOC_NAME1) If Err = 0 Then If MsgBox("Do you want to save the current document " _ & "before updating the data?", vbYesNo) = vbYes Then .Dialogs(wdDialogFileSaveAs).Show End If doc.Close False End If On Error GoTo ErrorHandler Set doc = .Documents.Open(DOC_PATH1 & DOC_NAME1, , True) Set rst = New ADODB.Recordset strSQL = "SELECT * FROM PRODUCTS" rst.Open strSQL, CurrentProject.Connection, _ adOpenStatic, adLockReadOnly If Not rst.EOF Then strReportsTo = Nz(rst.Fields(0).Value) rst.Close End If With doc .FormFields("fldCompanyName").result = Nz(Me!CompanyName) .FormFields("fldAddress1").result = Nz(Me!Address1) .FormFields("fldAddress2").result = Nz(Me!Address2) .FormFields("fldCity").result = Nz(Me!City) .FormFields("fldRegion").result = Nz(Me!Region) .FormFields("fldPostalCode").result = Nz(Me!PostalCode) .FormFields("fldProductName").result = Nz(Me!ProductName) .FormFields("fldQty").result = Nz(Me!Qty) .FormFields("fldPrice").result = Nz(Me!Price) .FormFields("fldDeliveryFee").result = Nz(Me!DeliveryFee) End With .Visible = True .Activate End With Set rst = Nothing Set doc = Nothing Set appWord = Nothing Exit Sub ErrorHandler: MsgBox Err & Err.Description End Sub Private Sub cmdPrintProducts2 _Click() Dim appWord As Word.Application Dim doc As Word.Document Dim rst As ADODB.Recordset Dim strSQL As String Dim strReportsTo As String On Error Resume Next Set appWord = GetObject(, "Word.application") If Err = 429 Then Set appWord = New Word.Application Err = 0 End If With appWord Set doc = .Documents(DOC_NAME2) If Err = 0 Then If MsgBox("Do you want to save the current document " _ & "before updating the data?", vbYesNo) = vbYes Then .Dialogs(wdDialogFileSaveAs).Show End If doc.Close False End If On Error GoTo ErrorHandler Set doc = .Documents.Open(DOC_PATH2 & DOC_NAME2, , True) Set rst = New ADODB.Recordset strSQL = "SELECT * FROM PRODUCTS" rst.Open strSQL, CurrentProject.Connection, _ adOpenStatic, adLockReadOnly If Not rst.EOF Then strReportsTo = Nz(rst.Fields(0).Value) rst.Close End If With doc .FormFields("fldCompanyName").result = Nz(Me!CompanyName) .FormFields("fldAddress1").result = Nz(Me!Address1) .FormFields("fldAddress2").result = Nz(Me!Address2) .FormFields("fldCity").result = Nz(Me!City) .FormFields("fldRegion").result = Nz(Me!Region) .FormFields("fldPostalCode").result = Nz(Me!PostalCode) .FormFields("fldProductName").result = Nz(Me!ProductName) .FormFields("fldQty").result = Nz(Me!Qty) .FormFields("fldPrice").result = Nz(Me!Price) .FormFields("fldDeliveryFee").result = Nz(Me!DeliveryFee) End With .Visible = True .Activate End With Set rst = Nothing Set doc = Nothing Set appWord = Nothing Exit Sub ErrorHandler: MsgBox Err & Err.Description End Sub Private Sub cmdPrintProducts3_Click() Dim appWord As Word.Application Dim doc As Word.Document Dim rst As ADODB.Recordset Dim strSQL As String Dim strReportsTo As String On Error Resume Next Set appWord = GetObject(, "Word.application") If Err = 429 Then Set appWord = New Word.Application Err = 0 End If With appWord Set doc = .Documents(DOC_NAME3) If Err = 0 Then If MsgBox("Do you want to save the current document " _ & "before updating the data?", vbYesNo) = vbYes Then .Dialogs(wdDialogFileSaveAs).Show End If doc.Close False End If On Error GoTo ErrorHandler Set doc = .Documents.Open(DOC_PATH3 & DOC_NAME3, , True) Set rst = New ADODB.Recordset strSQL = "SELECT * FROM PRODUCTS" rst.Open strSQL, CurrentProject.Connection, _ adOpenStatic, adLockReadOnly If Not rst.EOF Then strReportsTo = Nz(rst.Fields(0).Value) rst.Close End If With doc .FormFields("fldCompanyName").result = Nz(Me!CompanyName) .FormFields("fldAddress1").result = Nz(Me!Address1) .FormFields("fldAddress2").result = Nz(Me!Address2) .FormFields("fldCity").result = Nz(Me!City) .FormFields("fldRegion").result = Nz(Me!Region) .FormFields("fldPostalCode").result = Nz(Me!PostalCode) .FormFields("fldProductName").result = Nz(Me!ProductName) .FormFields("fldQty").result = Nz(Me!Qty) .FormFields("fldPrice").result = Nz(Me!Price) .FormFields("fldDeliveryFee").result = Nz(Me!DeliveryFee) End With .Visible = True .Activate End With Set rst = Nothing Set doc = Nothing Set appWord = Nothing Exit Sub ErrorHandler: MsgBox Err & Err.Description End Sub ================================================== ============== The REST of the code is deleted for ease-of-viewing ================================================== ============== Private Sub Form_RecordExit(Cancel As Integer) ' Hide the errormsg label to reduce flashing when navigating ' between records. errormsg.Visible = False End Sub Private Sub RemovePicture_Click() ' Clear the file name for the employee record and display the ' errormsg label. Me![ImagePath] = "" hideImageFrame errormsg.Visible = True End Sub Private Sub Form_AfterUpdate() ' Requery the ReportsTo combo box after a record has been changed. ' Then, either show the errormsg label if no file name exists for ' the employee record or display the image if there is a file name that ' exists. 'Me!ReportsTo.Requery On Error Resume Next showErrorMessage showImageFrame If (IsRelative(Me!ImagePath) = True) Then Me![ImageFrame].Picture = path & Me![ImagePath] Else Me![ImageFrame].Picture = Me![ImagePath] End If End Sub Private Sub ImagePath_AfterUpdate() ' After selecting an image for the employee, display it. On Error Resume Next showErrorMessage showImageFrame If (IsRelative(Me!ImagePath) = True) Then Me![ImageFrame].Picture = path & Me![ImagePath] Else Me![ImageFrame].Picture = Me![ImagePath] End If End Sub Private Sub Form_Current() ' Display the picture for the current employee record if the image ' exists. If the file name no longer exists or the file name was blank ' for the current employee, set the errormsg label caption to the ' appropriate message. Dim res As Boolean Dim fName As String path = CurrentProject.path On Error Resume Next errormsg.Visible = False If Not IsNull(Me!Photo) Then res = IsRelative(Me!Photo) fName = Me![ImagePath] If (res = True) Then fName = path & "\" & fName End If Me![ImageFrame].Picture = fName showImageFrame Me.PaintPalette = Me![ImageFrame].ObjectPalette If (Me![ImageFrame].Picture fName) Then hideImageFrame errormsg.Caption = "Picture not found" errormsg.Visible = True End If Else hideImageFrame errormsg.Caption = "Click Add/Change to add picture" errormsg.Visible = True End If End Sub Sub getFileName() ' Displays the Office File Open dialog to choose a file name ' for the current employee record. If the user selects a file ' display it in the image control. Dim fileName As String Dim result As Integer With Application.FileDialog(msoFileDialogFilePicker) .Title = "Select Employee Picture" .Filters.Add "All Files", "*.*" .Filters.Add "JPEGs", "*.jpg" .Filters.Add "Bitmaps", "*.bmp" .FilterIndex = 3 .AllowMultiSelect = False .InitialFileName = CurrentProject.path result = .Show If (result 0) Then fileName = Trim(.SelectedItems.Item(1)) Me![ImagePath].Visible = True Me![ImagePath].SetFocus Me![ImagePath].Text = fileName Me![FirstName].SetFocus Me![ImagePath].Visible = False End If End With End Sub Sub showErrorMessage() ' Display the errormsg label if the image file is not available. If Not IsNull(Me!Photo) Then errormsg.Visible = False Else errormsg.Visible = True End If End Sub Function IsRelative(fName As String) As Boolean ' Return false if the file name contains a drive or UNC path IsRelative = (InStr(1, fName, ":") = 0) And (InStr(1, fName, "\\") = 0) End Function Sub hideImageFrame() ' Hide the image control Me![ImageFrame].Visible = False End Sub Sub showImageFrame() ' Display the image control Me![ImageFrame].Visible = True End Sub |
#14
|
|||
|
|||
Copy Data From an ACCESS form to a WORD Template
Doc
just because these people slander me; it doesn't make me wrong. Anyone using MDB in the year 2007 should be fired and then spit upon. It is the equivalent of using LEECHES in the medical field "Doctorjones_md" wrote in message ... I appreciate the explanation (and concern) Doug and 69 -- thanks. "Douglas J. Steele" wrote in message ... Please note that this post is from Aar.on Kem.pff, a known troll. -- Doug Steele, Microsoft Access MVP http://I.Am/DougSteele (no e-mails, please!) "Tom Wickerath MDB" wrote in message ... wtf, why would you link to SQL Server you should be using Access Data Projects and you should be using REPORTS isntead of word how did you make it through medical school? have yuo always been this much of a dumb****? FILE, NEW, PROJECT EXISTING DATA spit on anyone still using jet for anything "Doctorjones_md" wrote in message ... I have a Front-End ACCESS db (linked to (3) Tables on a Back-End SQL Server). I have a series of Queries that manipulate the data and populate an ACCESS Form. This Form has the following features: 1. A Main Form, with several pages (Tabs) which display data from one (OverallData) Table a. One of these pages (Tabs) contains a Sub-Form which displays data from another (SpecificData) Table Here's my quandry ... I'm trying to display (in the WORD template) a field from the Sub-Form -- how do I modify the code-syntax to accomplish this? Example: .FormFields("fldDeliveryFee").result = Nz(Me!DeliveryFee) NOW: I want to include "GrossPurchaseTotal" from the Sub-Form (which is populated from a seperate table) -- what do I need to modify to accomplish this? I have the following code which I use to display the data (via Text Form Fields) in my WORD document: ====================================== Option Compare Database Option Explicit Dim path As String Const DOC_PATH1 As String = "\\Fileserver\Products\ " Const DOC_NAME1 As String = _ "Products1.dot" Const DOC_PATH2 As String = "\\Fileserver\Products\ " Const DOC_NAME2 As String = _ " Products2.dot " Const DOC_PATH3 As String = "\\Fileserver\Products\ " Const DOC_NAME3 As String = _ " Products3.dot " Private Sub AddPicture_Click() ' Use the Office File Open dialog to get a file name to use ' as an employee picture. getFileName End Sub Private Sub cmdPrint Products1_Click() Dim appWord As Word.Application Dim doc As Word.Document Dim rst As ADODB.Recordset Dim strSQL As String Dim strReportsTo As String On Error Resume Next Set appWord = GetObject(, "Word.application") If Err = 429 Then Set appWord = New Word.Application Err = 0 End If With appWord Set doc = .Documents(DOC_NAME1) If Err = 0 Then If MsgBox("Do you want to save the current document " _ & "before updating the data?", vbYesNo) = vbYes Then .Dialogs(wdDialogFileSaveAs).Show End If doc.Close False End If On Error GoTo ErrorHandler Set doc = .Documents.Open(DOC_PATH1 & DOC_NAME1, , True) Set rst = New ADODB.Recordset strSQL = "SELECT * FROM PRODUCTS" rst.Open strSQL, CurrentProject.Connection, _ adOpenStatic, adLockReadOnly If Not rst.EOF Then strReportsTo = Nz(rst.Fields(0).Value) rst.Close End If With doc .FormFields("fldCompanyName").result = Nz(Me!CompanyName) .FormFields("fldAddress1").result = Nz(Me!Address1) .FormFields("fldAddress2").result = Nz(Me!Address2) .FormFields("fldCity").result = Nz(Me!City) .FormFields("fldRegion").result = Nz(Me!Region) .FormFields("fldPostalCode").result = Nz(Me!PostalCode) .FormFields("fldProductName").result = Nz(Me!ProductName) .FormFields("fldQty").result = Nz(Me!Qty) .FormFields("fldPrice").result = Nz(Me!Price) .FormFields("fldDeliveryFee").result = Nz(Me!DeliveryFee) End With .Visible = True .Activate End With Set rst = Nothing Set doc = Nothing Set appWord = Nothing Exit Sub ErrorHandler: MsgBox Err & Err.Description End Sub Private Sub cmdPrintProducts2 _Click() Dim appWord As Word.Application Dim doc As Word.Document Dim rst As ADODB.Recordset Dim strSQL As String Dim strReportsTo As String On Error Resume Next Set appWord = GetObject(, "Word.application") If Err = 429 Then Set appWord = New Word.Application Err = 0 End If With appWord Set doc = .Documents(DOC_NAME2) If Err = 0 Then If MsgBox("Do you want to save the current document " _ & "before updating the data?", vbYesNo) = vbYes Then .Dialogs(wdDialogFileSaveAs).Show End If doc.Close False End If On Error GoTo ErrorHandler Set doc = .Documents.Open(DOC_PATH2 & DOC_NAME2, , True) Set rst = New ADODB.Recordset strSQL = "SELECT * FROM PRODUCTS" rst.Open strSQL, CurrentProject.Connection, _ adOpenStatic, adLockReadOnly If Not rst.EOF Then strReportsTo = Nz(rst.Fields(0).Value) rst.Close End If With doc .FormFields("fldCompanyName").result = Nz(Me!CompanyName) .FormFields("fldAddress1").result = Nz(Me!Address1) .FormFields("fldAddress2").result = Nz(Me!Address2) .FormFields("fldCity").result = Nz(Me!City) .FormFields("fldRegion").result = Nz(Me!Region) .FormFields("fldPostalCode").result = Nz(Me!PostalCode) .FormFields("fldProductName").result = Nz(Me!ProductName) .FormFields("fldQty").result = Nz(Me!Qty) .FormFields("fldPrice").result = Nz(Me!Price) .FormFields("fldDeliveryFee").result = Nz(Me!DeliveryFee) End With .Visible = True .Activate End With Set rst = Nothing Set doc = Nothing Set appWord = Nothing Exit Sub ErrorHandler: MsgBox Err & Err.Description End Sub Private Sub cmdPrintProducts3_Click() Dim appWord As Word.Application Dim doc As Word.Document Dim rst As ADODB.Recordset Dim strSQL As String Dim strReportsTo As String On Error Resume Next Set appWord = GetObject(, "Word.application") If Err = 429 Then Set appWord = New Word.Application Err = 0 End If With appWord Set doc = .Documents(DOC_NAME3) If Err = 0 Then If MsgBox("Do you want to save the current document " _ & "before updating the data?", vbYesNo) = vbYes Then .Dialogs(wdDialogFileSaveAs).Show End If doc.Close False End If On Error GoTo ErrorHandler Set doc = .Documents.Open(DOC_PATH3 & DOC_NAME3, , True) Set rst = New ADODB.Recordset strSQL = "SELECT * FROM PRODUCTS" rst.Open strSQL, CurrentProject.Connection, _ adOpenStatic, adLockReadOnly If Not rst.EOF Then strReportsTo = Nz(rst.Fields(0).Value) rst.Close End If With doc .FormFields("fldCompanyName").result = Nz(Me!CompanyName) .FormFields("fldAddress1").result = Nz(Me!Address1) .FormFields("fldAddress2").result = Nz(Me!Address2) .FormFields("fldCity").result = Nz(Me!City) .FormFields("fldRegion").result = Nz(Me!Region) .FormFields("fldPostalCode").result = Nz(Me!PostalCode) .FormFields("fldProductName").result = Nz(Me!ProductName) .FormFields("fldQty").result = Nz(Me!Qty) .FormFields("fldPrice").result = Nz(Me!Price) .FormFields("fldDeliveryFee").result = Nz(Me!DeliveryFee) End With .Visible = True .Activate End With Set rst = Nothing Set doc = Nothing Set appWord = Nothing Exit Sub ErrorHandler: MsgBox Err & Err.Description End Sub ================================================== ============== The REST of the code is deleted for ease-of-viewing ================================================== ============== Private Sub Form_RecordExit(Cancel As Integer) ' Hide the errormsg label to reduce flashing when navigating ' between records. errormsg.Visible = False End Sub Private Sub RemovePicture_Click() ' Clear the file name for the employee record and display the ' errormsg label. Me![ImagePath] = "" hideImageFrame errormsg.Visible = True End Sub Private Sub Form_AfterUpdate() ' Requery the ReportsTo combo box after a record has been changed. ' Then, either show the errormsg label if no file name exists for ' the employee record or display the image if there is a file name that ' exists. 'Me!ReportsTo.Requery On Error Resume Next showErrorMessage showImageFrame If (IsRelative(Me!ImagePath) = True) Then Me![ImageFrame].Picture = path & Me![ImagePath] Else Me![ImageFrame].Picture = Me![ImagePath] End If End Sub Private Sub ImagePath_AfterUpdate() ' After selecting an image for the employee, display it. On Error Resume Next showErrorMessage showImageFrame If (IsRelative(Me!ImagePath) = True) Then Me![ImageFrame].Picture = path & Me![ImagePath] Else Me![ImageFrame].Picture = Me![ImagePath] End If End Sub Private Sub Form_Current() ' Display the picture for the current employee record if the image ' exists. If the file name no longer exists or the file name was blank ' for the current employee, set the errormsg label caption to the ' appropriate message. Dim res As Boolean Dim fName As String path = CurrentProject.path On Error Resume Next errormsg.Visible = False If Not IsNull(Me!Photo) Then res = IsRelative(Me!Photo) fName = Me![ImagePath] If (res = True) Then fName = path & "\" & fName End If Me![ImageFrame].Picture = fName showImageFrame Me.PaintPalette = Me![ImageFrame].ObjectPalette If (Me![ImageFrame].Picture fName) Then hideImageFrame errormsg.Caption = "Picture not found" errormsg.Visible = True End If Else hideImageFrame errormsg.Caption = "Click Add/Change to add picture" errormsg.Visible = True End If End Sub Sub getFileName() ' Displays the Office File Open dialog to choose a file name ' for the current employee record. If the user selects a file ' display it in the image control. Dim fileName As String Dim result As Integer With Application.FileDialog(msoFileDialogFilePicker) .Title = "Select Employee Picture" .Filters.Add "All Files", "*.*" .Filters.Add "JPEGs", "*.jpg" .Filters.Add "Bitmaps", "*.bmp" .FilterIndex = 3 .AllowMultiSelect = False .InitialFileName = CurrentProject.path result = .Show If (result 0) Then fileName = Trim(.SelectedItems.Item(1)) Me![ImagePath].Visible = True Me![ImagePath].SetFocus Me![ImagePath].Text = fileName Me![FirstName].SetFocus Me![ImagePath].Visible = False End If End With End Sub Sub showErrorMessage() ' Display the errormsg label if the image file is not available. If Not IsNull(Me!Photo) Then errormsg.Visible = False Else errormsg.Visible = True End If End Sub Function IsRelative(fName As String) As Boolean ' Return false if the file name contains a drive or UNC path IsRelative = (InStr(1, fName, ":") = 0) And (InStr(1, fName, "\\") = 0) End Function Sub hideImageFrame() ' Hide the image control Me![ImageFrame].Visible = False End Sub Sub showImageFrame() ' Display the image control Me![ImageFrame].Visible = True End Sub |
#15
|
|||
|
|||
Copy Data From an ACCESS form to a WORD Template
While I appreciate your willingness to impart knowledge (or best practices),
your guidance/input lacks the finesse of someone whose main goal is to be heard. My advice to parents has always been not to yield to the screaming child, but to guide them back to productive communication. I offer this this advice, not to infuriate, but to motivate. Have a Fanatical Day! "Tom Wimpernark" wrote in message ... Doc just because these people slander me; it doesn't make me wrong. Anyone using MDB in the year 2007 should be fired and then spit upon. It is the equivalent of using LEECHES in the medical field "Doctorjones_md" wrote in message ... I appreciate the explanation (and concern) Doug and 69 -- thanks. "Douglas J. Steele" wrote in message ... Please note that this post is from Aar.on Kem.pff, a known troll. -- Doug Steele, Microsoft Access MVP http://I.Am/DougSteele (no e-mails, please!) "Tom Wickerath MDB" wrote in message ... wtf, why would you link to SQL Server you should be using Access Data Projects and you should be using REPORTS isntead of word how did you make it through medical school? have yuo always been this much of a dumb****? FILE, NEW, PROJECT EXISTING DATA spit on anyone still using jet for anything "Doctorjones_md" wrote in message ... I have a Front-End ACCESS db (linked to (3) Tables on a Back-End SQL Server). I have a series of Queries that manipulate the data and populate an ACCESS Form. This Form has the following features: 1. A Main Form, with several pages (Tabs) which display data from one (OverallData) Table a. One of these pages (Tabs) contains a Sub-Form which displays data from another (SpecificData) Table Here's my quandry ... I'm trying to display (in the WORD template) a field from the Sub-Form -- how do I modify the code-syntax to accomplish this? Example: .FormFields("fldDeliveryFee").result = Nz(Me!DeliveryFee) NOW: I want to include "GrossPurchaseTotal" from the Sub-Form (which is populated from a seperate table) -- what do I need to modify to accomplish this? I have the following code which I use to display the data (via Text Form Fields) in my WORD document: ====================================== Option Compare Database Option Explicit Dim path As String Const DOC_PATH1 As String = "\\Fileserver\Products\ " Const DOC_NAME1 As String = _ "Products1.dot" Const DOC_PATH2 As String = "\\Fileserver\Products\ " Const DOC_NAME2 As String = _ " Products2.dot " Const DOC_PATH3 As String = "\\Fileserver\Products\ " Const DOC_NAME3 As String = _ " Products3.dot " Private Sub AddPicture_Click() ' Use the Office File Open dialog to get a file name to use ' as an employee picture. getFileName End Sub Private Sub cmdPrint Products1_Click() Dim appWord As Word.Application Dim doc As Word.Document Dim rst As ADODB.Recordset Dim strSQL As String Dim strReportsTo As String On Error Resume Next Set appWord = GetObject(, "Word.application") If Err = 429 Then Set appWord = New Word.Application Err = 0 End If With appWord Set doc = .Documents(DOC_NAME1) If Err = 0 Then If MsgBox("Do you want to save the current document " _ & "before updating the data?", vbYesNo) = vbYes Then .Dialogs(wdDialogFileSaveAs).Show End If doc.Close False End If On Error GoTo ErrorHandler Set doc = .Documents.Open(DOC_PATH1 & DOC_NAME1, , True) Set rst = New ADODB.Recordset strSQL = "SELECT * FROM PRODUCTS" rst.Open strSQL, CurrentProject.Connection, _ adOpenStatic, adLockReadOnly If Not rst.EOF Then strReportsTo = Nz(rst.Fields(0).Value) rst.Close End If With doc .FormFields("fldCompanyName").result = Nz(Me!CompanyName) .FormFields("fldAddress1").result = Nz(Me!Address1) .FormFields("fldAddress2").result = Nz(Me!Address2) .FormFields("fldCity").result = Nz(Me!City) .FormFields("fldRegion").result = Nz(Me!Region) .FormFields("fldPostalCode").result = Nz(Me!PostalCode) .FormFields("fldProductName").result = Nz(Me!ProductName) .FormFields("fldQty").result = Nz(Me!Qty) .FormFields("fldPrice").result = Nz(Me!Price) .FormFields("fldDeliveryFee").result = Nz(Me!DeliveryFee) End With .Visible = True .Activate End With Set rst = Nothing Set doc = Nothing Set appWord = Nothing Exit Sub ErrorHandler: MsgBox Err & Err.Description End Sub Private Sub cmdPrintProducts2 _Click() Dim appWord As Word.Application Dim doc As Word.Document Dim rst As ADODB.Recordset Dim strSQL As String Dim strReportsTo As String On Error Resume Next Set appWord = GetObject(, "Word.application") If Err = 429 Then Set appWord = New Word.Application Err = 0 End If With appWord Set doc = .Documents(DOC_NAME2) If Err = 0 Then If MsgBox("Do you want to save the current document " _ & "before updating the data?", vbYesNo) = vbYes Then .Dialogs(wdDialogFileSaveAs).Show End If doc.Close False End If On Error GoTo ErrorHandler Set doc = .Documents.Open(DOC_PATH2 & DOC_NAME2, , True) Set rst = New ADODB.Recordset strSQL = "SELECT * FROM PRODUCTS" rst.Open strSQL, CurrentProject.Connection, _ adOpenStatic, adLockReadOnly If Not rst.EOF Then strReportsTo = Nz(rst.Fields(0).Value) rst.Close End If With doc .FormFields("fldCompanyName").result = Nz(Me!CompanyName) .FormFields("fldAddress1").result = Nz(Me!Address1) .FormFields("fldAddress2").result = Nz(Me!Address2) .FormFields("fldCity").result = Nz(Me!City) .FormFields("fldRegion").result = Nz(Me!Region) .FormFields("fldPostalCode").result = Nz(Me!PostalCode) .FormFields("fldProductName").result = Nz(Me!ProductName) .FormFields("fldQty").result = Nz(Me!Qty) .FormFields("fldPrice").result = Nz(Me!Price) .FormFields("fldDeliveryFee").result = Nz(Me!DeliveryFee) End With .Visible = True .Activate End With Set rst = Nothing Set doc = Nothing Set appWord = Nothing Exit Sub ErrorHandler: MsgBox Err & Err.Description End Sub Private Sub cmdPrintProducts3_Click() Dim appWord As Word.Application Dim doc As Word.Document Dim rst As ADODB.Recordset Dim strSQL As String Dim strReportsTo As String On Error Resume Next Set appWord = GetObject(, "Word.application") If Err = 429 Then Set appWord = New Word.Application Err = 0 End If With appWord Set doc = .Documents(DOC_NAME3) If Err = 0 Then If MsgBox("Do you want to save the current document " _ & "before updating the data?", vbYesNo) = vbYes Then .Dialogs(wdDialogFileSaveAs).Show End If doc.Close False End If On Error GoTo ErrorHandler Set doc = .Documents.Open(DOC_PATH3 & DOC_NAME3, , True) Set rst = New ADODB.Recordset strSQL = "SELECT * FROM PRODUCTS" rst.Open strSQL, CurrentProject.Connection, _ adOpenStatic, adLockReadOnly If Not rst.EOF Then strReportsTo = Nz(rst.Fields(0).Value) rst.Close End If With doc .FormFields("fldCompanyName").result = Nz(Me!CompanyName) .FormFields("fldAddress1").result = Nz(Me!Address1) .FormFields("fldAddress2").result = Nz(Me!Address2) .FormFields("fldCity").result = Nz(Me!City) .FormFields("fldRegion").result = Nz(Me!Region) .FormFields("fldPostalCode").result = Nz(Me!PostalCode) .FormFields("fldProductName").result = Nz(Me!ProductName) .FormFields("fldQty").result = Nz(Me!Qty) .FormFields("fldPrice").result = Nz(Me!Price) .FormFields("fldDeliveryFee").result = Nz(Me!DeliveryFee) End With .Visible = True .Activate End With Set rst = Nothing Set doc = Nothing Set appWord = Nothing Exit Sub ErrorHandler: MsgBox Err & Err.Description End Sub ================================================== ============== The REST of the code is deleted for ease-of-viewing ================================================== ============== Private Sub Form_RecordExit(Cancel As Integer) ' Hide the errormsg label to reduce flashing when navigating ' between records. errormsg.Visible = False End Sub Private Sub RemovePicture_Click() ' Clear the file name for the employee record and display the ' errormsg label. Me![ImagePath] = "" hideImageFrame errormsg.Visible = True End Sub Private Sub Form_AfterUpdate() ' Requery the ReportsTo combo box after a record has been changed. ' Then, either show the errormsg label if no file name exists for ' the employee record or display the image if there is a file name that ' exists. 'Me!ReportsTo.Requery On Error Resume Next showErrorMessage showImageFrame If (IsRelative(Me!ImagePath) = True) Then Me![ImageFrame].Picture = path & Me![ImagePath] Else Me![ImageFrame].Picture = Me![ImagePath] End If End Sub Private Sub ImagePath_AfterUpdate() ' After selecting an image for the employee, display it. On Error Resume Next showErrorMessage showImageFrame If (IsRelative(Me!ImagePath) = True) Then Me![ImageFrame].Picture = path & Me![ImagePath] Else Me![ImageFrame].Picture = Me![ImagePath] End If End Sub Private Sub Form_Current() ' Display the picture for the current employee record if the image ' exists. If the file name no longer exists or the file name was blank ' for the current employee, set the errormsg label caption to the ' appropriate message. Dim res As Boolean Dim fName As String path = CurrentProject.path On Error Resume Next errormsg.Visible = False If Not IsNull(Me!Photo) Then res = IsRelative(Me!Photo) fName = Me![ImagePath] If (res = True) Then fName = path & "\" & fName End If Me![ImageFrame].Picture = fName showImageFrame Me.PaintPalette = Me![ImageFrame].ObjectPalette If (Me![ImageFrame].Picture fName) Then hideImageFrame errormsg.Caption = "Picture not found" errormsg.Visible = True End If Else hideImageFrame errormsg.Caption = "Click Add/Change to add picture" errormsg.Visible = True End If End Sub Sub getFileName() ' Displays the Office File Open dialog to choose a file name ' for the current employee record. If the user selects a file ' display it in the image control. Dim fileName As String Dim result As Integer With Application.FileDialog(msoFileDialogFilePicker) .Title = "Select Employee Picture" .Filters.Add "All Files", "*.*" .Filters.Add "JPEGs", "*.jpg" .Filters.Add "Bitmaps", "*.bmp" .FilterIndex = 3 .AllowMultiSelect = False .InitialFileName = CurrentProject.path result = .Show If (result 0) Then fileName = Trim(.SelectedItems.Item(1)) Me![ImagePath].Visible = True Me![ImagePath].SetFocus Me![ImagePath].Text = fileName Me![FirstName].SetFocus Me![ImagePath].Visible = False End If End With End Sub Sub showErrorMessage() ' Display the errormsg label if the image file is not available. If Not IsNull(Me!Photo) Then errormsg.Visible = False Else errormsg.Visible = True End If End Sub Function IsRelative(fName As String) As Boolean ' Return false if the file name contains a drive or UNC path IsRelative = (InStr(1, fName, ":") = 0) And (InStr(1, fName, "\\") = 0) End Function Sub hideImageFrame() ' Hide the image control Me![ImageFrame].Visible = False End Sub Sub showImageFrame() ' Display the image control Me![ImageFrame].Visible = True End Sub |
#16
|
|||
|
|||
Copy Data From an ACCESS form to a WORD Template
Please trim this thread to a reasonable length when replying
so as to avoid placing an undue burden on everyone. Not only is each post going from redundantly lenghty to ridiculously long, but it is unnecessarily crossposted to EIGHT newsgroups. -- Marsh MVP [MS Access] |
#17
|
|||
|
|||
Copy Data From an ACCESS form to a WORD Template
I've never paid any attention to (as you call it) "Trimming", since most ask
us to Reply to Group -- is this better? As far as the length of an entry -- shouldn't it be whatever it takes to get one's point across? I'm not sure what burden you're referring to -- I don't usually read threads that don't interest or pertain to me (unless what you mean to say is, "to avoid placing an undue burden on the MVPs -- I'm assuming that folks of lesser knowledge use these forums to learn from those who are more learned -- I apologize for any posts which have been lengthy. At times, it is difficult to be precise when asking for assistance, but I will try my best! "Marshall Barton" wrote in message ... Please trim this thread to a reasonable length when replying so as to avoid placing an undue burden on everyone. Not only is each post going from redundantly lenghty to ridiculously long, but it is unnecessarily crossposted to EIGHT newsgroups. -- Marsh MVP [MS Access] |
|
Thread Tools | |
Display Modes | |
|
|