Populating Word form template with Excel data

[SkylabOne]

Dear masters of Excel,

My Excel workbook contains extensive data which is constantly updated with new project numbers (below is obviously an example).

I've created a Word form template called Invoice Request which is now filled in manually, but this is prone to error and it takes too much time.
Upon opening the Wordfile the user should be prompted to fill in a project number and the corresponding data should be filled in automatically.

My problem: I do not know how to do this. I did find out that I should use bookmarks, but I can't seem to link them to my Word file.

ClientNumber	ClientName	ProjectNumber	ContactPerson
1	Jane's Bar	1401	Jane
2	Jim's Restaurant	1405	Jim
3	Joe's Kitchen	1410	Joe

<tbody>
</tbody>

I understand this is more of a Word related question than Excel, but both Excel and VBA are used for this, so I hope someone who reads this will have a sample code for me.

Thank you in advance.

Kind regards,
Rolf

 

[SkylabOne]

Hi J.,

Thanks for asking! It's coming better and better. I have decided to migrate my database to Access. My apologies for this long post, I hope you can take the time to look at my issue.


1.) [WORKS] Short code, initializing the userform when the Word document opens:

Private Sub UserForm_Initialize()Dim dbs As DAO.Database
Dim rst As DAO.Recordset


Set dbs = OpenDatabase(ActiveDocument.Path & "\Contacts.accdb")
Set rst = dbs.OpenRecordset("Select Company FROM Contacts;")
    
    'Fill combo by looping through the recordset
    Do While Not rst.EOF
        Me.cboContacts.AddItem rst("Company")
        rst.MoveNext
    Loop


'Clean up
Set rst = Nothing
Set dbs = Nothing
End Sub

2.) [WORKS] This code fills my bookmarks, based on the Company name selected in the userform:

Private Sub cmdInsert_Click()Dim dbs As DAO.Database
Dim rst As DAO.Recordset


 'If no selection was made exit sub
If Me.cboContacts.ListIndex = -1 Then
    Beep
    MsgBox "Make a choice first", 64, "Choose from list"
    
    Exit Sub
Else


 'Hide form
 Me.Hide
 
'Establish connection
Set dbs = OpenDatabase(ActiveDocument.Path & "\Contacts.accdb")


'Fill recordset with data matching the text of combo cboContacts
Set rst = dbs.OpenRecordset("Select * FROM Contacts WHERE Company = '" & _
                            Me.cboContacts.Text & "';")
    
    'Write values of Recordset fields to bookmarks in the document
    Call FillBookmark("" & rst.Fields("Company"), "bmCompany")
    Call FillBookmark("" & rst.Fields("Contact_Person"), "bmContact_Person")
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Call FillBookmark("" & rst.Fields("Company"), "bmCompany2")
    Call FillBookmark("" & rst.Fields("Address"), "bmAddress")
    Call FillBookmark("" & rst.Fields("Postal") & Chr$(32) & rst.Fields("City"), "bmCity")
    Call FillBookmark("" & rst.Fields("Country"), "bmCountry")
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Call FillBookmark("" & rst.Fields("Company"), "bmCompany3")
    Call FillBookmark("" & rst.Fields("Invoice_Address"), "bmInvoice_Address")
    Call FillBookmark("" & rst.Fields("Invoice_Postal") & Chr$(32) & rst.Fields("Invoice_City"), "bmInvoice_City")
    Call FillBookmark("" & rst.Fields("Invoice_Country"), "bmInvoice_Country")
    Call FillBookmark("" & rst.Fields("Department"), "bmDepartment")
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Call FillBookmark("" & rst.Fields("Project"), "bmProject")
    Call FillBookmark("" & rst.Fields("Project"), "bmProject2")
    Call FillBookmark("" & rst.Fields("Phone"), "bmPhone")
    Call FillBookmark("" & rst.Fields("Email"), "bmEmail")
    Call FillBookmark("" & rst.Fields("VAT_Number"), "bmVAT_Number")
    
'If ListLogo <> Null Then
    'ActiveDocument.Bookmarks("bmLogo").Range _
        '.InlineShapes.AddPicture FileName:=ThisDocument.Path & "\logos\" & ListLogo
'End If
    
    ActiveDocument.Fields.Update 'Update linked fields
End If


'Clean up
    Unload Me 'give resources back to the system
Set rst = Nothing
Set dbs = Nothing
End Sub

3.) [DOESN'T WORK] I'm having trouble with this part. Ultimately I'd like the image bookmark filled in with the code above, but I can't figure out how to call on and insert an image from Access to Word. My solution is that I created a seperate clickable part which opens a dialog and the right image is manually added.

a.) This should be automated, but I don't know how.
b.) The image can have a maximum height of 2.5 centimeters, if it's bigger then it should resize, keeping the aspect ratio. This doesn't work yet either and I'm trying to figure out how.

'In UserForm called frmContactsOption Explicit
Private Sub cboImage_Click()

Dim sPath As String
    sPath = "C:\Users\rolft\Desktop\DAO - Copy\Logos"
    Options.DefaultFilePath(wdPicturesPath) = sPath

 Dim oDialog As Dialog
 Dim strFile As String
 Dim oImage As Object
 Dim oRng As Object

     Set oDialog = Dialogs(wdDialogInsertPicture)
     With oDialog
         .Display
         If .Name <> "" Then
             strFile = .Name
         End If
     End With
     
     Selection.GoTo What:=wdGoToBookmark, Name:="bmLogo"
     Set oImage = Selection.InlineShapes.AddPicture(strFile)
     With oImage
         .LockAspectRatio = msoTrue
         '.Height = CentimetersToPoints(2.5)
         '.Width = (Width / Height) * Height
         Set oRng = .ConvertToShape

     End With
     With oRng
         .RelativeHorizontalPosition = _
         wdRelativeHorizontalPositionMargin
         .RelativeVerticalPosition = _
         wdRelativeVerticalPositionMargin

     End With
 Set oDialog = Nothing
 Set oImage = Nothing
 Set oRng = Nothing

End Sub

Thank you for reading into my problem.

Kind regards,
Rolf

 

[DarC69]

Hi Rolf,

I'm having a similar problem however I don't have the option of switching to Access so I was wondering if it was possible to implement something like the code you have the "FillBookmark" function that you are using.

Regards