(Solved) – Filling Word document from Excel with text and image, help wanted for the image part

  • by

The files I’m busy with helps me with filling Word documents and saving a lot of time. It is kind of mailmerging, except for the fact that one Excel file has multiple VBA’s in it to fill differend Word documents, depending on the VBA that is called.

All tekst is filled in with Bookmarks in Word. I now know how to change the code for me to work. The only thing I really have no clue about is getting an image from Excel into Word.

As I want to reduce the amount of different documents I try to get a name and signature of a selected manager out of Excel into Word. The name of the selected manager works fine, as it is just a Bookmark. The

The signature of the selected manager is dynamic, based on the selected manager. As my Excel file never exceeds 30 rows I added 30 times the signature. They all change when I select another manager. It just works.

The VBA I use for filling the documents looks like the code below. It has a built in check for the last row filled with data. The name of the maneger comes from column 97, the signature image is in column 98.

I would appreciate it if someone could push me in the right direction and give me a helping hand with this. I’m (still) not a programmer but I try to save a lot of time for me and all my coworkers.

Option Explicit

Sub Manager()

  Dim lonLaatsteRij As Integer, aantalrijenrngData As Integer
  Dim rngData As Range
  Dim strManager As String, strSignature As String
  Dim c As Range

With Sheets("Cijferlijst")
    lonLaatsteRij = 30
        Do Until .Cells(lonLaatsteRij, 1) <> ""
            lonLaatsteRij = lonLaatsteRij - 1
    Set rngData = .Range(.Cells(2, 1), .Cells(lonLaatsteRij, 1))
End With

  For Each c In rngData
    strManager = c.Offset(0, 97).Value
    strSignature= c.Offset(0, 98).Value
    Call maakWordDocument(strManager, strSignature)
  Next c

  MsgBox "Aantal gegenereerde documenten: " & lonLaatsteRij - 1

End Sub

Private Sub maakWordDocument(strManager As String, strSignatureAs String)

    'maak een verwijzing naar de Microsoft Word 16.0 Object Library!!

    Dim wordApp As Object, WordDoc As Object

    On Error Resume Next

    'kijk of word al open staat
    Set wordApp = GetObject("", "Word.Application")
    'open word
    If wordApp Is Nothing Then
      'If Not open, open Word Application
      Set wordApp = CreateObject("Word.Application")
    End If
    'toon word (of niet, dan op false)
    wordApp.Visible = False
    'open het 'bron'-bestand
    Set WordDoc = wordApp.Documents.Open(ThisWorkbook.Path & "FormulierenTEST.docx")

    'bladwijzers invullen
    Call InvullenBladwijzer(wordApp, "manager", strManager)
    Call InvullenBladwijzer(wordApp, "signature", strSignature)

    'bestand opslaan en alles netjes afsluiten
    wordApp.DisplayAlerts = False
    WordDoc.SaveAs Filename:=ThisWorkbook.Path & "AkkoordverklaringTEST " & strManager, FileFormat:=wdFormatDocumentDefault
    Set WordDoc = Nothing
    Set wordApp = Nothing
    'wordApp.DisplayAlerts = True

    'On Error GoTo 0

End Sub

Sub InvullenBladwijzer(wordApp As Object, strBladwijzer As String, strTekst As String)

  'tekst invullen in relevante strBladwijzer
  wordApp.Selection.Goto What:=wdGoToBookmark, Name:=strBladwijzer
  wordApp.Selection.TypeText strTekst

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

End Sub

Leave a Reply

Your email address will not be published. Required fields are marked *