Option Explicit
Public Sub createDocuments()
Dim appWord As Word.Application
Dim docDeutsch As Word.Document, docEnglisch As Word.Document, docTmp As Word.Document
On Error GoTo cleanUp
Set appWord = CreateObject("Word.Application")
With appWord.Documents
Set docDeutsch = .Open(ThisWorkbook.Path & "\deutsch.docx")
Set docEnglisch = .Open(ThisWorkbook.Path & "\englisch.docx")
End With
Dim wks As Worksheet
Dim l As Long: l = 2
Set wks = ThisWorkbook.Worksheets("Tabelle1")
Do While Not wks.Cells(l, 1).Value = vbNullString
Select Case wks.Cells(l, 1).Value
Case "deutsch":
Set docTmp = docDeutsch
Case "englisch":
Set docTmp = docEnglisch
Case Else:
MsgBox "Der Wert '" & wks.Cells(l, 1).Value & "' wird nicht unterstützt!", vbExclamation
End Select
With docTmp
.ResetFormFields
.FormFields("txtFeld1").Result = wks.Cells(l, 2).Value
.SaveAs ThisWorkbook.Path & "\" & wks.Cells(l, 1).Value & ".pdf", 17
End With
l = l + 1
Loop
docEnglisch.Close False
docDeutsch.Close False
appWord.Quit
cleanUp:
If Err.Number Then
MsgBox "Es ist leider ein Fehler aufgetreten." & vbCrLf & _
"Fehlernummer: " & Err.Number & _
"Fehlerbeschreibung: " & Err.Description, vbExclamation
End If
If Not docTmp Is Nothing Then Set docTmp = Nothing
If Not wks Is Nothing Then Set wks = Nothing
If Not appWord Is Nothing Then Set appWord = Nothing
If Not docDeutsch Is Nothing Then Set docDeutsch = Nothing
If Not docEnglisch Is Nothing Then Set docEnglisch = Nothing
End Sub