Thema Datum  Von Nutzer Rating
Antwort
Rot VBA Word - Serienbrief mit Bildern und Feldern
27.09.2024 01:41:01 Florian
NotSolved

Ansicht des Beitrags:
Von:
Florian
Datum:
27.09.2024 01:41:01
Views:
79
Rating: Antwort:
  Ja
Thema:
VBA Word - Serienbrief mit Bildern und Feldern

Hallo zusammen,

ich benutze windows 11 und office 365.

Ich lese zunächst aus einer Exceldatei Felder für Seriendruck ein. Dabei werden Felder und Dateipfade für Bilder eingelesen.

Das Word Dokument enthält Felder und Lesezeichen. Über die Lesezeichen werden später die Bilder eingefügt.

Den Seriendruck und das einfügen der Bilder steuer ich über einen VBA Code in Word.

In dem untenstehenden Code, werden Bilder korrekt eingefügt, aber die Felder aus dem Seriendruck nicht ausgefüllt.

Ich hoffe ich habe das Problem ausreichend genau beschrieben. ich wäre über Hilfe sehr dankbar.

 

Viele Grüße

Florian

Sub SeriendruckMitMehrerenBildernInEinzeldokumenteUndPDF3()
    Dim docVorlage As Document
    Dim docEinzel As Document
    Dim strDateiname As String
    Dim strBildPfad As String
    Dim pfad As String
    Dim i As Integer
    Dim rng As Range
    Dim bildFelder As Variant
    Dim bildLesezeichen As Variant
    Dim j As Integer
    
    ' Pfad anpassen, wo die Dateien gespeichert werden sollen
    pfad = "c:\TEMP\_Test_OZD_Reports\M3\" ' Passe diesen Pfad an

    ' Bildspalten und dazugehörige Lesezeichen festlegen (Spaltenname in der Excel-Datei und entsprechendes Lesezeichen in Word)
    bildFelder = Array("Uebersicht", "Foto1", "Foto2", "Foto3", "Fotodoc1", "Fotodoc2", "Fotodoc3") ' Excel-Spaltennamen für Bildpfade
    bildLesezeichen = Array("UebersichtLZ", "Foto1LZ", "Foto2LZ", "Foto3LZ", "Fotodoc1LZ", "Fotodoc2LZ", "Fotodoc3LZ") ' Lesezeichen in Word
    
    ' Aktuelles Dokument (Vorlage) speichern
    Set docVorlage = ActiveDocument
    
    ' Prüfen, ob Seriendruckdaten vorhanden sind
    If docVorlage.MailMerge.DataSource.RecordCount > 0 Then
        ' Schleife durch alle Datensätze im Seriendruck
        For i = 1 To docVorlage.MailMerge.DataSource.RecordCount
            ' Wechselt zum jeweiligen Datensatz
            docVorlage.MailMerge.DataSource.ActiveRecord = i
            
            ' Neues Dokument basierend auf der Vorlage erstellen
            Set docEinzel = Documents.Add(Template:=docVorlage.FullName)
            
            ' Erstellen des Dateinamens basierend auf einem Seriendruckfeld (z.B. Name)
            strDateiname = docVorlage.MailMerge.DataSource.DataFields("NameDoc").Value
            
            ' Schleife durch die Bildspalten und füge die Bilder ein
            For j = LBound(bildFelder) To UBound(bildFelder)
                ' Bildpfad aus der jeweiligen Spalte holen
                strBildPfad = docVorlage.MailMerge.DataSource.DataFields(bildFelder(j)).Value
                
                ' Prüfen, ob der Bildpfad gültig ist und das Lesezeichen im Dokument vorhanden ist
                If Len(strBildPfad) > 0 And Len(Dir(strBildPfad)) > 0 Then
                    ' Prüfen, ob das Lesezeichen vorhanden ist
                    If docEinzel.Bookmarks.Exists(bildLesezeichen(j)) Then
                        Set rng = docEinzel.Bookmarks(bildLesezeichen(j)).Range
                        ' Bild einfügen
                        rng.InlineShapes.AddPicture FileName:=strBildPfad, LinkToFile:=False, SaveWithDocument:=True
                    Else
                        MsgBox "Lesezeichen nicht gefunden: " & bildLesezeichen(j)
                    End If
                End If
            Next j
            
            ' Word-Dokument speichern
            docEinzel.SaveAs2 FileName:=pfad & strDateiname & ".docx", FileFormat:=wdFormatXMLDocument
            
            ' PDF speichern
            docEinzel.ExportAsFixedFormat OutputFileName:=pfad & strDateiname & ".pdf", _
                                          ExportFormat:=wdExportFormatPDF, _
                                          OpenAfterExport:=False, _
                                          OptimizeFor:=wdExportOptimizeForPrint, _
                                          Range:=wdExportAllDocument, _
                                          Item:=wdExportDocumentContent, _
                                          IncludeDocProps:=True, _
                                          KeepIRM:=True, _
                                          CreateBookmarks:=wdExportCreateNoBookmarks, _
                                          DocStructureTags:=True, _
                                          BitmapMissingFonts:=True, _
                                          UseISO19005_1:=False
            
            ' Dokument schließen, ohne zu speichern
            docEinzel.Close False
        Next i
    Else
        MsgBox "Keine Datensätze für den Seriendruck vorhanden."
    End If
End Sub

 

 

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:

 
 

  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot VBA Word - Serienbrief mit Bildern und Feldern
27.09.2024 01:41:01 Florian
NotSolved