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

Ein einfaches Beispiel - unterschiedliche Textfelder in einem Word Dokument füllen mit Daten aus Excel.

A simple example - different text fields in a Word document, fill it with data from Excel.

Hier noch eine Beispieldatei / Here's a sample file:
Unterschiedliche Textfelder in Word aus Excel befüllen...[ZIP 100 KB]

Option Explicit
'--------------------------------------------------------------------------
' Module    : Modul1
' Procedure : Main
' Author    : Case (Ralf Stolzenburg)
' Date      : 02.08.2016
' Purpose   : Word - Datei öffnen, verschiedene Textfelder befüllen...
'--------------------------------------------------------------------------
Public Sub Main()
    Dim strPathFile1 As String
    Dim strPathFile As String
    Dim strBookmark As String
    Dim objWDDocV As Object
    Dim objWDDoc As Object
    Dim objWDApp As Object
    Dim lngCalc As Long
    ' Wenn ein Fehler auftritt gehe zu der angegebenen Sprungmarke
    On Error GoTo Fin
    ' Die Excelapplikation wird ruhig gestellt - UNBEDINGT wieder einschalten
    With Application
        ' 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
    End With
    ' 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
    Set objWDApp = OffApp("Word", False)
    If Not objWDApp Is Nothing Then
        ' Worddatei öffnen und auf Objektvariable festlegen
        Set objWDDoc = objWDApp.Documents.Open(strPathFile, , True)
        ' Worddatei aus Vorlage öffnen und auf Objektvariable festlegen
        Set objWDDocV = 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
        With objWDDoc
            .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"
        End With
        ' 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
        With objWDDocV
            .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"
        End With
    End If
    ' 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
    Set objWDDocV = Nothing
    Set objWDDoc = Nothing
    Set objWDApp = Nothing
    ' Die Applikation aufwecken
    With Application
        ' 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
    End With
    ' Wenn ein Fehler auftritt gib ihn aus mit Fehlernummer und Beschreibung
    If Err.Number <> 0 Then MsgBox "Error: " & _
        Err.Number & " " & Err.Description
End Sub
'--------------------------------------------------------------------------
' Module    : Modul1
' Procedure : OffApp
' Author    : Case (Ralf Stolzenburg)
' Date      : 02.08.2016
' Purpose   : Start application...
'--------------------------------------------------------------------------
Private Function OffApp(ByVal strApp As String, _
    Optional blnVisible As Boolean = True) As Object
    Dim objApp As Object
    On Error Resume Next
    Set objApp = GetObject(, strApp & ".Application")
    Select Case Err.Number
        Case 429
            Err.Clear
            Set objApp = CreateObject(strApp & ".Application")
            objApp.Visible = blnVisible
    End Select
    Set OffApp = objApp
    Set objApp = Nothing
End Function

Kommentare

Beliebte Posts aus diesem Blog

Formeln - auch Array - per VBA eintragen...

Alle Dateien eines Ordners - Optional mit Unterordner

Excel -> Word in Textmarken (Bookmarks)...