Unterschiedliche Textfelder in Word aus Excel befüllen...

OptionExplicit
'--------------------------------------------------------------------------
' Module    : Modul1
' Procedure : Main
' Author    : Case (Ralf Stolzenburg)
' Date      : 02.08.2016
' Purpose   : Word - Datei öffnen, verschiedene Textfelder befüllen...
'--------------------------------------------------------------------------
PublicSubMain()
DimstrPathFile1AsString
DimstrPathFileAsString
DimstrBookmarkAsString
DimobjWDDocVAsObject
DimobjWDDocAsObject
DimobjWDAppAsObject
DimlngCalcAsLong
' Wenn ein Fehler auftritt gehe zu der angegebenen Sprungmarke
OnErrorGoToFin
' Die Excelapplikation wird ruhig gestellt - UNBEDINGT wieder einschalten
WithApplication
' Das Bildschirmaktualisierung wird unterbrochen
.ScreenUpdating=False
' Ereignisroutinen werden deaktiviert
.EnableEvents=False
' Auslesen der momentanen Einstellung für die Berechnung
lngCalc=.Calculation
' Setzen der Berechnung auf "Manuell"
.Calculation=xlCalculationManual
'  Eingabeaufforderungen und Warnmeldungen unterdrücken
.DisplayAlerts=False
EndWith
' Pfad und Dateiname der WordVORLAGE. Diese ist im selben Ordner
' wie die Exceldatei mit dem Code
strPathFile1=ThisWorkbook.Path&Application.PathSeparator&_
"Textfelder_befuellen_aus_Excel.dotx"
' Pfad und Dateiname der Worddatei. Diese ist im selben Ordner
' wie die Exceldatei mit dem Code
strPathFile=ThisWorkbook.Path&Application.PathSeparator&_
"Textfelder_befuellen_aus_Excel.docx"
' Die Wordapplikation sichtbar starten
SetobjWDApp=OffApp("Word",False)
IfNotobjWDAppIsNothingThen
' Worddatei öffnen und auf Objektvariable festlegen
SetobjWDDoc=objWDApp.Documents.Open(strPathFile,,True)
' Worddatei aus Vorlage öffnen und auf Objektvariable festlegen
SetobjWDDocV=objWDApp.Documents.Add(Template:=strPathFile1)
' Der Code bezieht sich auf ein bestimmtes Objekt
' Hier das Worddokument
' Alles was sich auf dieses "With" bezieht
' MUSS mit einem Punkt beginnen
WithobjWDDoc
.FormFields("Text1").Result="Text1"
.TextBox1.Text="Text2"
.ContentControls(1).Range.Text="Text3"
.ContentControls(2).Range.Text="Text4"
.Shapes("Text Box 1").TextFrame.TextRange.Text="Text5"
EndWith
' Der Code bezieht sich auf ein bestimmtes Objekt
' Hier das Worddokument, das aus der Vorlage erstellt wurde
' Alles was sich auf dieses "With" bezieht
' MUSS mit einem Punkt beginnen
WithobjWDDocV
.FormFields("Text1").Result="Text1"
.TextBox1.Text="Text2"
.ContentControls(1).Range.Text="Text3"
.ContentControls(2).Range.Text="Text4"
.Shapes("Text Box 1").TextFrame.TextRange.Text="Text5"
EndWith
EndIf
' Die folgende Codezeile KANN raus, WENN die Datei dann z. B.
' gespeichert und geschlossen wird, also ein kompletter
' Durchgang gemacht wird
' IN UNSEREM BEISPIEL HIER NATÜRLICH NICHT!
objWDApp.Visible=True
Fin:
' Objektvariablen zurücksetzen
SetobjWDDocV=Nothing
SetobjWDDoc=Nothing
SetobjWDApp=Nothing
' Die Applikation aufwecken
WithApplication
' Bildschirmaktualisierung wieder einschalten
.ScreenUpdating=True
' Ereignisroutinen werden wieder aktiviert
.EnableEvents=True
' Setzen der Berechnung auf den gemerkten Wert
.Calculation=lngCalc
' Eingabeaufforderungen und Warnmeldungen wieder zulassen
.DisplayAlerts=True
' Abbrechen Ausschneide- bzw. Kopiermodus und entfernen des Laufrahmens
.CutCopyMode=True
EndWith
' Wenn ein Fehler auftritt gib ihn aus mit Fehlernummer und Beschreibung
IfErr.Number<>0ThenMsgBox"Error: "&_
Err.Number&" "&Err.Description
EndSub
'--------------------------------------------------------------------------
' Module    : Modul1
' Procedure : OffApp
' Author    : Case (Ralf Stolzenburg)
' Date      : 02.08.2016
' Purpose   : Start application...
'--------------------------------------------------------------------------
PrivateFunctionOffApp(ByValstrAppAsString,_
OptionalblnVisibleAsBoolean=True)AsObject
DimobjAppAsObject
OnErrorResumeNext
SetobjApp=GetObject(,strApp&".Application")
SelectCaseErr.Number
Case429
Err.Clear
SetobjApp=CreateObject(strApp&".Application")
objApp.Visible=blnVisible
EndSelect
SetOffApp=objApp
SetobjApp=Nothing
EndFunction