Excel Daten in Word Mergefield einfügen

[drr_ess]

Hallo zusammen,

mein Excel VBA Code fügt meine Mergefields in Word nicht ein.

Mein Code in Excel:

Private Sub btnAnzeigen_Click()
    Dim wdApp As Object
    Dim wdDoc As Object
    Dim Firma As String, Bauvorhaben As String, Bauleistung As String, Vom As String, Nr As String, Bauherr As String, Mit As String
    Dim Adresse As String, Adresse2 As String, Betrag As Double, Betragwort As String, Cent As Integer, Kür As String, Skonto As String
    Dim Mieternummer As String, Auf As String
    Dim Prozent As Double
    Dim FirmaRow As Range
    Dim AdresseTeil1 As String, AdresseTeil2 As String
   

    ' Werte aus Excel holen (oder direkt aus der UserForm)
    Dim ws As Worksheet, ws2 As Worksheet
    Dim rng As Range
    Set ws = ThisWorkbook.Sheets("Tabelle1")
    Set ws2 = ThisWorkbook.Sheets("Tabelle2")
   
    ' Werte setzen
    Firma = Me.CBFirma.Value ' Firma aus der ComboBox
   
    ' Suchen des Firmennamens in Spalte A
    Set FirmaRow = ws.Columns("A").Find(Firma, LookIn:=xlValues, LookAt:=xlWhole)
   
    ' Werte setzen
    Firma = Me.CBFirma.Value
   
    If TBBauvorhaben.Value = "" Then
        Bauvorhaben = Me.CBObjekt
    Else
        Bauvorhaben = Me.TBBauvorhaben.Value
    End If
   
    Bauleistung = Me.TBBauleistung.Value
    Vom = Me.TBVom.Value
    Nr = Me.TBNr.Value
    Mieternummer = Me.TBMieternummer.Value
    Auf = Me.TBAuf.Value
    Mit = Me.TBMit.Value
    Kür = Me.TBKürzel.Value
    Skonto = Me.TBProzent.Value
    NachverhandeltBetrag = Me.TBAuf.Value

  ' Betrag aus der UserForm
    If IsNumeric(Me.TBBetrag.Value) Then
        Betrag = CDbl(Me.TBBetrag.Value) ' Den Betrag als Zahl holen
    Else
        MsgBox "Bitte geben Sie einen gültigen Betrag ein.", vbExclamation
    End If
   
    ' Umwandlung des Betrags in Worte (ganz ohne Cent)
    Betragwort = LCase(ZahlWort(Int(Betrag))) ' Nur den Euro-Betrag verwenden, alles in Kleinbuchstaben
   
    ' Extrahieren des Centbetrags
    Cent = (Betrag - Int(Betrag)) * 100
   
    ' Ausgabe der Ergebnisse (z.B. für die Kontrolle)
    MsgBox "Betragwort: " & Betragwort & vbCrLf & "Cent: " & Cent & "/100"

    ' Word öffnen oder vorhandene Instanz nutzen
    On Error Resume Next
    Set wdApp = GetObject(, "Word.Application")
    If wdApp Is Nothing Then Set wdApp = CreateObject("Word.Application")
    On Error GoTo 0

    wdApp.Visible = True
    Set wdDoc = wdApp.Documents.Open("G:\Daten\Vorlagen\Bauvertrag\Bauvertrag_Festpreis.docx")
   
Dim field As Object
Dim debugText As String

For Each field In wdDoc.Fields
    debugText = debugText & "Feldcode: " & field.Code.Text & vbCrLf
Next field

If debugText = "" Then
    MsgBox "Keine MergeFields gefunden!", vbExclamation
Else
    MsgBox "Gefundene Felder:" & vbCrLf & debugText
End If


MsgBox "Gefundene MergeFields: " & vbCrLf & fieldNames
   
    ' MergeFields füllen
    With wdDoc.Fields
   
        Call UpdateMergeField(wdDoc, "FIRMA", Firma)
        Call UpdateMergeField(wdDoc, "BAUVORHABEN", Bauvorhaben)
        Call UpdateMergeField(wdDoc, "Mieternummer", Mieternummer)
        Call UpdateMergeField(wdDoc, "BAULEISTUNG", Bauleistung)
        'Call UpdateMergeField(wdDoc, "BVNR", Bvnr)
        Call UpdateMergeField(wdDoc, "VOM", Vom)
        Call UpdateMergeField(wdDoc, "NR", Nr)
        'Call UpdateMergeField(wdDoc, "BAUHERR", Bauherr)
        Call UpdateMergeField(wdDoc, "ADRESSE", Adresse)
        Call UpdateMergeField(wdDoc, "ADRESSE2", Adresse2)
        Call UpdateMergeField(wdDoc, "BETRAG", CStr(Betrag))
        Call UpdateMergeField(wdDoc, "BETRAGWORT", Betragwort)
        Call UpdateMergeField(wdDoc, "CENT", CStr(Cent))
        'Call UpdateMergeField(wdDoc, "SKONTO", Skonto)
        Call UpdateMergeField(wdDoc, "MIT", Mit)
        Call UpdateMergeField(wdDoc, "AUF", Auf)
       
    End With

    ' Aktualisiere alle Felder im Dokument
    wdDoc.Fields.Update
    wdDoc.Activate ' Aktiviert das Dokument
    wdApp.Selection.WholeStory
    wdApp.Selection.Fields.Update

End Sub

Private Sub UpdateMergeField(wdDoc As Object, FieldName As String, Value As String)
    Dim field As Object
    Dim found As Boolean
    found = False
   
    For Each field In wdDoc.Fields
        If InStr(1, field.Code.Text, "MERGEFIELD " & FieldName, vbTextCompare) > 0 Then
            field.Select
            wdDoc.Application.Selection.TypeText Value
            found = True
            Exit For ' Beendet die Schleife nach erstem Treffer
        End If
    Next field
   
    If Not found Then
        MsgBox "Feld " & FieldName & " wurde nicht gefunden!", vbExclamation
    End If
End Sub

Vielen Dank im voraus

[derHoepp]

Moin,

Mergefields füllt man für gewöhnlich nicht mit Einzelwerten, sondern mit einer Datenquelle (genau dafür sind sie ja da, Dokumente mit Datenquellen zu vereinen). Wenn du ein Druckformular verwenden willst, nutze in Word besser Felder, die auf DocVars zugreifen.

Viele Grüße
derHoepp

[Klaus-Dieter]

Hallo,

das ist jetzt aber nicht dein Ernst. Du haust uns einen offenbar fehlerhaften Quelltext um die Ohren, und erwartest, dass wir auf Fehlersuche gehen? Dazu würde man ja wenigstens die Dateien benötigen, oder sollen wir die nachbauen? 
Hast du mal darüber nachgedacht, ob die Serienbrieffunktion von Word dein Vorhaben nicht effizienter lösen könnte?

[derHoepp]

Moin,

der Code für eine UserForm könnte q'n'd dabei in etwa so aussehen:

Code:

Option Explicit

Private mTargetDocument As Word.Document

Private Sub CommandButton1_Click()
    UpdateWordfields
End Sub

Private Sub UserForm_Initialize()
    Dim wdapp As Word.Application
    Set wdapp = New Word.Application
    wdapp.Visible = True
    Set mTargetDocument = wdapp.Documents.Open("C:\Daten\Druckvorlage.docx")
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    mTargetDocument.Application.Quit False
End Sub

Private Sub UpdateWordfields()
    Dim ctrl As Object
    
    For Each ctrl In Me.Controls
        If ctrl.Tag <> "" Then
            addOrUpdateVariable mTargetDocument, ctrl.Tag, ctrl.value
        End If
    Next ctrl
    
    
    mTargetDocument.Fields.Update
End Sub

Private Sub addOrUpdateVariable(doc As Word.Document, Name As String, value As Variant)
    Dim var As Word.Variable
    On Error Resume Next
        Set var = doc.Variables(Name)
    On Error GoTo 0
    If var Is Nothing Then
        doc.Variables.Add Name, value
    Else
        var.value = value
    End If
End Sub

Dabei habe ich die Namen der zu verwendenden Document-Variablen in die .Tag-Eigenschaft der zugehörigen Controls geschrieben. Das lässt sich natürlich auch anders lösen. Wäre das mein Projekt, würde ich wahrscheinlich auch die addOrUpdate...()-Methode als Member des Document-Objekts schreiben und diese nicht in den Code der UserForm verpacken. Das Word-Dokument verweist dabei einfach im Fließtext auf die Documentvariable.

Viele Grüße
derHöpp