Word Datei aus Template erzeugen und mit Inhalt füllen

In diesem Beispiel füllen wir eine Word Datei mit Inhalt aus Excel via VBA.

Option Explicit

Sub LieferscheinErzeugen()

'Variablendeklaration
Dim objApp                 As Object
Dim intZaehler             As Integer
Dim strPfad                As String
Dim objZeile               As Object
Dim varRowNumber           As Variant

'Fehler übergehen
On Error Resume Next

'Word als App setzen
Set objApp = GetObject(, "Word.Application")

On Error GoTo 0

'Word als App anlegen wenn nicht vorhanden
If objApp Is Nothing Then
   Set objApp = CreateObject("Word.Application")
   objApp.Visible = True
End If

'Word Dokument Vorlage laden
strPfad = ActiveWorkbook.Path & "\Template\Template.dotx"
objApp.Documents.Open (strPfad)

'Kopfdaten Textmarken füllen
With objApp
    'Dokument anhand des Templates erstellen
    .Documents.Add Template:=strPfad
    .Visible = True 'Sichtbarkeit
    .WindowState = 1
    Worksheets("Kopfdaten").Activate
    
    'Textmarken füllen
    objApp.ActiveDocument.Bookmarks("Empfänger_Name").Range.Text = Range("C4").Value
    objApp.ActiveDocument.Bookmarks("Empfänger_Straße").Range.Text = Range("C5").Value
    objApp.ActiveDocument.Bookmarks("Empfänger_PLZ_Ort").Range.Text = Range("C6").Value
    objApp.ActiveDocument.Bookmarks("Zusatz").Range.Text = Range("C7").Value
    objApp.ActiveDocument.Bookmarks("Kundenbestellnummer").Range.Text = Range("C8").Value
    objApp.ActiveDocument.Bookmarks("Bestelldatum").Range.Text = Range("C9").Value
    objApp.ActiveDocument.Bookmarks("Kundennummer").Range.Text = Range("C10").Value
    objApp.ActiveDocument.Bookmarks("UST").Range.Text = Range("C11").Value
    objApp.ActiveDocument.Bookmarks("Zeichen").Range.Text = Range("C12").Value
    objApp.ActiveDocument.Bookmarks("Auftrag").Range.Text = Range("C13").Value
    objApp.ActiveDocument.Bookmarks("Zuständig").Range.Text = Range("C14").Value
    objApp.ActiveDocument.Bookmarks("Durchwahl").Range.Text = Range("C15").Value
    objApp.ActiveDocument.Bookmarks("Lieferschein").Range.Text = Range("C16").Value
    objApp.ActiveDocument.Bookmarks("Datum").Range.Text = Range("C17").Value
    
End With

'Inhalt füllen
With objApp.Selection
    Worksheets("Artikel").Activate
    
    objApp.ActiveDocument.Bookmarks("Inhalt").Select
    
    
    For Each objZeile In Range("A2:I300").Rows  'definiert den zu durchsuchenden Bereich
    If objZeile.Cells(1, 6) > 0 Then    'wenn in Spalte Menge für den jeweiligen Conainer > 0 ist
        .TypeText Text:=CStr(objZeile.Cells(1, 6))
        .TypeText Text:=CStr(objZeile.Cells(1, 1))
        objApp.Selection.InsertBreak Type:=6
        varRowNumber = varRowNumber + 1
    End If
    Next objZeile
    
    objApp.Activate

    Set objApp = Nothing
    
End With

End Sub