Office: Mit Excel VBA Seriendruck im Word ausführen

User · 30. April 2011

Hallo

Ich habe eine Excel Datei mit vielen Daten, und eine Word Seriendruck Datei mit der Quelle in dieser Excel Datei.

Im Word habe ich einen Datensatz für eine Zeile im Excel. Nun möchte ich mit einem Excel Makro in jeder Zeile (über Schaltfläche), dass es mir nur diese Zeile vom Seriendruck Dokument herausfiltert und druckt.

Wie ist dass möglich??

Mfg

:)

User · 2. Mai 2011

.....

IngGi · 2. Mai 2011

Hallo,

folgendes Makro erzeugt von Excel aus eine neue Wordinstanz im Hintergrund. Darin wird das Serienbriefdokument geladen und für jeden Datensatz der verbundenen Datenquelle ein Dokument erzeugt, das in einem vorgegebenen Pfad mit einem Namen gespeichert wird, der sich aus einer Spalte der Datenquelle ergibt.

Anschließend wird das Serienbriefdokument geschlossen, ohne zu speichern und die Wordinstanz wird wieder beendet, ohne je sichtbar im Vordergrund gewesen zu sein.

Das Makro wird von mir eigentlich direkt unter Word verwendet. Ich habe es nun einfach mal mit der Hand am Arm so umgeschrieben, dass es von Excel aus funktionieren sollte.

'#######################################################
'# #
'# Code einfügen in: #
'# ein allgemeines (benutzerdefiniertes) Modul #
'# #
'#######################################################
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Public Sub Seriendruck_in_getrennte_Dateien()

Dim wdApp As Object
Dim dok As Object
Dim iBrief As Integer
Dim sBrief As String

Set wdApp = CreateObject("Word.Application")
Set dok = wdApp.Documents.Open("Pfad\zu\deiner\Datei.doc")

With dok.MailMerge
.DataSource.ActiveRecord = 1
Do
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = .ActiveRecord
.LastRecord = .ActiveRecord
'Der Dateiname ergibt sich für jeden Datensatz aus einem fest
'vorgegebenen Pfad und der Spalte "Blubber" aus der Exceldatei!
'sowie der Dateiendung ".doc"
sBrief = "Speicherpfad\der\erzeugten\Dateien\" _
& .DataFields("Blubber") & ".doc"
End With
.Execute Pause:=False

dok.SaveAs Filename:=sBrief
dok.Close False

If .DataSource.ActiveRecord < .DataSource.RecordCount Then
.DataSource.ActiveRecord = wdNextRecord
Else
Exit Do
End If
Loop
End With

wdApp.Quit

Set dok = Nothing
Set wdApp = Nothing

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

VBA/HTML - CodeConverter für Excelforen
AddIn für Excel XP+2003 - komplett in VBA geschrieben von IngGi
Anbindung an VBE-Kontextmenü geklaut ;-) bei:
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

M4rtin · 14. Juni 2011

Hallo zusammen,

ich weiß, der Eintrag ist ne weile her, allerdings sitze ich gerade vor dem gleichen Problem.
Ich habe Deinen Code mal ausprobiert, allerdings kommt bei mir folgende Fehlermeldung:

Laufzeitfehler'5852' - Das angeforderte Objekt ist nicht verfügbar
... in folgender Zeile:

Set wdApp = CreateObject("Word.Application")
Set dok = wdApp.Documents.Open("C:\Users\Netbook\Desktop\Abweichungsformular\Serienbrief.docx")

With dok.MailMerge
---> .DataSource.ActiveRecord = 1

Wo liegt das Problem?

Vielen Dank im Vorraus

IngGi · 14. Juni 2011

Hallo Martin,

das Dokument muss noch mit der Excel-Datendatei verbunden werden. Pfad und Namen der Excel-Quelldatei musst du im Code noch zwei mal anpassen, ausserdem je ein mal den Namen des Tabellenblattes und die Spaltenüberschrift der Spalte, aus der sich der Name der zu speichernden Worddatei ergibt (bei mit "Blubber").

Es sei auch nochmal daran erinnert, dass das Makro so noch nicht deinen Anforderungen entspricht, da für alle Datensätze der Quelldatei eine Serienbriefdatei im angegebenen Pfad erzeugt wird.

Wenn du nur für einen bestimmten Datensatz eine Ausgabe willst, könntest du beispielsweise diesen einen Datensatz zusammen mit den Spaltenüberschriften in eine neue temporäre Datei kopieren, diese dann als Quelldatei angeben und abschließend wieder löschen. Bekommst du das alleine hin?

'#######################################################
'# #
'# Code einfügen in: #
'# ein allgemeines (benutzerdefiniertes) Modul #
'# #
'#######################################################
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Public Sub Seriendruck_in_getrennte_Dateien()

Dim wdApp As Object
Dim dok As Object
Dim iBrief As Integer
Dim sBrief As String

Set wdApp = CreateObject("Word.Application")
Set dok = wdApp.Documents.Open("Pfad\zu\deiner\Datei.doc")

dok.MailMerge.MainDocumentType = 0
dok.MailMerge.OpenDataSource _
Name:="C:\Pfad\zur\Exceldatei.xlsx", _
ConfirmConversions:=False, _
ReadOnly:=False, _
LinkToSource:=True, _
AddToRecentFiles:=False, _
PasswordDocument:="", _
PasswordTemplate:="", _
WritePasswordDocument:="", _
WritePasswordTemplate:="", _
Revert:=False, _
Format:=0, _
Connection:="Provider=Microsoft.Jet.OLEDB.4.0;Password="""";" & _
"User ID=Admin;Data Source=C:\Pfad\zur\Exceldatei.xlsx;Mode=Read;" & _
"Extended Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";" & _
"Jet OLEDB:Registry Path="""";Jet OLE", _
SQLStatement:="SELECT * FROM `'Tabelle1$'`", _
SQLStatement1:="", _
SubType:=1

With dok.MailMerge
.DataSource.ActiveRecord = 1
Do
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = .ActiveRecord
.LastRecord = .ActiveRecord
'Der Dateiname ergibt sich für jeden Datensatz aus einem fest
'vorgegebenen Pfad und der Spalte "Blubber" aus der Exceldatei!
'sowie der Dateiendung ".doc"
sBrief = "Speicherpfad\der\erzeugten\Dateien\" _
& .DataFields("Blubber") & ".doc"
End With
.Execute Pause:=False

dok.SaveAs Filename:=sBrief
dok.Close False

If .DataSource.ActiveRecord < .DataSource.RecordCount Then
.DataSource.ActiveRecord = wdNextRecord
Else
Exit Do
End If
Loop
End With

wdApp.Quit

Set dok = Nothing
Set wdApp = Nothing

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

VBA/HTML - CodeConverter für Excelforen
AddIn für Excel XP+2003 - komplett in VBA geschrieben von IngGi
Anbindung an VBE-Kontextmenü geklaut ;-) bei:
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

M4rtin · 16. Juni 2011

Vielen Dank für Deine Hilfe.
Den Code habe ich angepasst, leider wird das Worddokument nicht geöffnet. Nach der Beendigung mit dem Taskmanager, kommt ein Dialogfeld mit: "das Dokument ist gesperrt"...

Code:

Public Sub Seriendruck_in_getrennte_Dateien()

Dim wdApp As Object
Dim dok As Object
Dim iBrief As Integer
Dim sBrief As String

Application.DisplayAlerts = False

Set wdApp = CreateObject("Word.Application")
Set dok = wdApp.Documents.Open("C:\Users\Netbook\Desktop\Abweichungsformular\Serienbrief.docx")

dok.MailMerge.MainDocumentType = 0
dok.MailMerge.OpenDataSource _
Name:="C:\Users\Netbook\Desktop\Daten.xlsx", _
ConfirmConversions:=False, _
ReadOnly:=False, _
LinkToSource:=True, _
AddToRecentFiles:=False, _
PasswordDocument:="", _
PasswordTemplate:="", _
WritePasswordDocument:="", _
WritePasswordTemplate:="", _
Revert:=False, _
Format:=0, _
Connection:="Provider=Microsoft.Jet.OLEDB.4.0;Password="""";" & _
"User ID=Admin;Data Source=C:\Users\Netbook\Desktop\Daten.xlsx;Mode=Read;" & _
"Extended Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";" & _
"Jet OLEDB:Registry Path="""";Jet OLE", _
SQLStatement:="SELECT * FROM `'Tabelle1$'`", _
SQLStatement1:="", _
SubType:=1

With dok.MailMerge
.DataSource.ActiveRecord = 1
Do
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = .ActiveRecord
.LastRecord = .ActiveRecord
'Der Dateiname ergibt sich für jeden Datensatz aus einem fest
'vorgegebenen Pfad und der Spalte "Blubber" aus der Exceldatei!
'sowie der Dateiendung ".doc"
sBrief = "C:\Users\Netbook\Desktop\Abweichungsformular\" _
& .DataFields("B:B") & ".docx"
End With
.Execute Pause:=False

dok.SaveAs Filename:=sBrief
dok.Close False

If .DataSource.ActiveRecord < .DataSource.RecordCount Then
.DataSource.ActiveRecord = wdNextRecord
Else
Exit Do
End If
Loop
End With

wdApp.Quit

Set dok = Nothing
Set wdApp = Nothing

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Gruß

Martin

M4rtin · 16. Juni 2011

Hmmm...
Ich habe ein paar Sachen verändert...
Allerdings findet er die Tabelle nicht.

Es liegt bestimmt nur an einer Kleinigkeit.

Public Sub Seriendruck_in_getrennte_Dateien()

Dim wdApp As Object
Dim dok As Object
Dim iBrief As Integer
Dim sBrief As String

Application.DisplayAlerts = False

Set wdApp = CreateObject("Word.Application")
Set dok = wdApp.Documents.Open("C:\Users\Netbook\Desktop\Abweichungsformular\Serienbrief.docx")

dok.MailMerge.MainDocumentType = 0
dok.MailMerge.OpenDataSource _
Name:="C:\Users\Netbook\Desktop\Abweichungsformular\Daten.xlsm", _
ConfirmConversions:=False, _
ReadOnly:=False, _
LinkToSource:=True, _
AddToRecentFiles:=False, _
PasswordDocument:="", _
PasswordTemplate:="", _
WritePasswordDocument:="", _
WritePasswordTemplate:="", _
Revert:=False, _
Format:=0, _
Connection:="Provider=Microsoft.Jet.OLEDB.4.0;Password="""";" & _
"User ID=Admin;Data Source=C:\Users\Netbook\Desktop\Abweichungsformular\Daten.xlsm;Mode=Read;" & _
"Extended Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";" & _
"Jet OLEDB:Registry Path="""";Jet OLE", _
SQLStatement:="SELECT * FROM `'Tabelle1$'`", _
SQLStatement1:="", _
SubType:=1

With dok.MailMerge
.DataSource.ActiveRecord = 1
Do
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = .ActiveRecord
.LastRecord = .ActiveRecord
'Der Dateiname ergibt sich für jeden Datensatz aus einem fest
'vorgegebenen Pfad und der Spalte "Blubber" aus der Exceldatei!
'sowie der Dateiendung ".doc"
sBrief = "C:\Users\Netbook\Desktop\Abweichungsformular\" _
& .DataFields(Worksheets("Tabelle2").Cells("B:B")) & ".docx"
End With
.Execute Pause:=False

dok.SaveAs Filename:=sBrief
dok.Close False

If .DataSource.ActiveRecord < .DataSource.RecordCount Then
.DataSource.ActiveRecord = wdNextRecord
Else
Exit Do
End If
Loop
End With

wdApp.Quit

Set dok = Nothing
Set wdApp = Nothing

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

IngGi · 16. Juni 2011

Hallo Martin,

der Fehler liegt in der nachfolgenden Codezeile. Du beziehst dich auf die gesamte Spalte B, benötigst aber einen Verweis auf den Namen des Datenfeldes im Word-Serienbrief. Dieser Name ergibt sich aus der Spaltenüberschrift in der Exceldatei, die ich in der Zelle B1 vermute. Dann müsste die Codezeile so aussehen:

Code:

sBrief = "C:\Users\Netbook\Desktop\Abweichungsformular\" _
& .DataFields(Worksheets("Tabelle2").Cells("B1")) & ".docx"
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Und noch ein Tipp: In meinem zuletzt geposteten Code habe ich einige Wordkonstanten durch die Werte ersetzt, die sie repräsentieren. Ein paar weitere Wordkonstanten habe ich allerdings übersehen. Diese solltest du ebenfalls noch durch ihre Werte ersetzen, wenn das Makro auf mehreren PCs laufen soll.

Wordkonstanten erkennst du daran, dass sie mit wd beginnen. Deren Wert kannst du im VB-Editor von Word ermitteln. Blende dort das Direktfenster mit Strg+G ein und gib ein Fragezeichen, gefolgt von der Wordkonstanten ein. Nach drücken von Enter wird der Wert in der nächsten Zeile angezeigt.

Hintergrund: Das Makro funktioniert mit Wordkonstanten nur dann, wenn im VB-Editor von Excel ein Verweis auf die Word-Objektbibliothek gesetzt ist.

Gruß Ingolf

M4rtin · 17. Juni 2011

Vielen Dank für Deine Hilfe Ingolf.
Irgendwie will es noch nicht funktionieren...
Nach zurzer Zeit erscheint ein Dialog mit: "Tabelle wählen"
Im Dialog befindet sich der Speicherpfad mit einem xlsx hinten dran...
Wie z.B. C:\Mein\Speicherpfad.xlsx

Da ich in diesen Dialog nicht wirklich eine Wahl habe, gehe ich auf Abbrechen.
Jetzt wird mir folgende Fehlermeldung angezeigt: "Laufzeitfehler4198" Befehl misslungen. Markiert ist diese Codezeile...

Kannst Du mir ein Buch empfehlen, wo solche Codefragmente enthalten sind?
Meine Bücher enthalten leider nicht diese Thematik *frown.gif*

Weißt Du wo das Problem liegt?

Gruß

Martin

Code:

Public Sub Seriendruck_in_getrennte_Dateien()

Dim wdApp As Object
Dim dok As Object
Dim iBrief As Integer
Dim sBrief As String

Application.DisplayAlerts = False

Set wdApp = CreateObject("Word.Application")
Set dok = wdApp.Documents.Open("C:\Users\Netbook\Desktop\Abweichungsformular\Serienbrief.docx")

dok.MailMerge.MainDocumentType = 0
--->dok.MailMerge.OpenDataSource _
Name:="C:\Users\Netbook\Desktop\Abweichungsformular\Daten.xlsm", _
ConfirmConversions:=False, _
ReadOnly:=False, _
LinkToSource:=True, _
AddToRecentFiles:=False, _
PasswordDocument:="", _
PasswordTemplate:="", _
WritePasswordDocument:="", _
WritePasswordTemplate:="", _
Revert:=False, _
Format:=0, _
Connection:="Provider=Microsoft.Jet.OLEDB.4.0;Password="""";" & _
"User ID=Admin;Data Source=C:\Users\Netbook\Desktop\Abweichungsformular\Daten.xlsm;Mode=Read;" & _
"Extended Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";" & _
"Jet OLEDB:Registry Path="""";Jet OLE", _
SQLStatement:="SELECT * FROM `'Tabelle1$'`", _
SQLStatement1:="", _
---> SubType:=1

With dok.MailMerge
.DataSource.ActiveRecord = 1
Do
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = .ActiveRecord
.LastRecord = .ActiveRecord
'Der Dateiname ergibt sich für jeden Datensatz aus einem fest
'vorgegebenen Pfad und der Spalte "Blubber" aus der Exceldatei!
'sowie der Dateiendung ".doc"
sBrief = "C:\Users\Netbook\Desktop\Abweichungsformular\" _
& .DataFields(Worksheets("Tabelle1").Cells("B1")) & ".docx"
End With
.Execute Pause:=False

dok.SaveAs Filename:=sBrief
dok.Close False

If .DataSource.ActiveRecord < .DataSource.RecordCount Then
.DataSource.ActiveRecord = wdNextRecord
Else
Exit Do
End If
Loop
End With

wdApp.Quit

Set dok = Nothing
Set wdApp = Nothing

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Tanja79 · 17. Juni 2011

Hallo ihr Lieben,
genau nach diesem Thema habe ich gesucht. Leider bin ich totaler Anfänger und weiß gar nicht welche Schritte ich wie und wo ausführen muss um euer Makro zu benutzen.
Bei mir ist es auch so, dass ich eine Tabelle mit Werten habe. Ich habe beispielsweise 10 Datensätze(Reihen) von denen ich dann 5 auswähle um diese als Seriendruck (einzelne Seiten) zu erstellen.Muss ich in Word dann noch eine extra Vorlage erstellen in der die Werte dann eingefügt werden können?Oder wie funktioniert das?
Super wäre es, wenn ich einfach die Spalten auswählen könnte und auf einen Knopf in Excel drücke der mir die Berichte dann erstellt.
Meint ihr es wäre möglich, dass ich mir dabei unter die Arme greift. Wäre wirklich super lieb von euch!
Lieber Gruß,
Tanja

M4rtin · 18. Juni 2011

Hallo Tanja,

ich habe das gleiche vor. Mein Problem liegt noch an der Schnittstelle. Wenn das alles hier funktionert, dann stelle ich diese Lösung Online.

Also Eingabe per Userform
Fortlaufende Speicherung in einer Tabelle
Serienausdruck in einem Formular
Nochmaliger Ausdruck, per Auswahl
...

Aber wie gesagt, dass Problem ist noch nicht gelöst *frown.gif*

Grüße

Martin

M4rtin · 30. Juni 2011

Hallo zusammen,

schade, dass MS einen da so große Steine in den Weg liegt, wenn man so eine relativ simple Idee umsetzten möchte.
Könnt Ihr bitte noch einmal über den Code schauen?
Ich lade die Dateien mal hoch, eventuell hilft das mehr.

Vielen Dank für eure Hilfe.
LG

M4rtin

rei4711 · 1. März 2016

hello, ich bin neu hier und hätt ein Problem.

Ich will aus einer Excel-Datei (wird als Datenbank verwendet) aus der VBE (Oberfläche als Eingabemöglichkeit) heraus mittels eines Command Button eine Seite einer bestimmten Excel-Zeile (aktuellen) eines Serienbriefes per klick drucken.

Private Sub CommandButton4_Click()
Dim WordApp As Object
Dim strPath As String, strDatNam As String
strPath = ThisWorkbook.Path & "\Formblätter\Noten\"
strDatNam = "A Note.docx"
Set WordApp = CreateObject("Word.Application")
If Not WordApp Is Nothing Then
With WordApp
.documents.Open (strPath & strDatNam)
.Application.Visible = True
End With
End If
End Sub

funtioniert zwar, jedoch muss der Serienbrief immer mit der Quelldatei verbunden werden und dann die richtige Zeile des Serienbriefes ausgewählt und dann gedruckt werden.

wer kann mir bitte helfen

Office: Mit Excel VBA Seriendruck im Word ausführen

Mit Excel VBA Seriendruck im Word ausführen

Mit Excel VBA Seriendruck im Word ausführen

Mit Excel VBA Seriendruck im Word ausführen

Mit Excel VBA Seriendruck im Word ausführen

Mit Excel VBA Seriendruck im Word ausführen

Mit Excel VBA Seriendruck im Word ausführen - Similar Threads - Excel VBA Seriendruck

VBA: Spalten auf anderen Worksheeds in der Mappe ausblenden.

Excel VBA Spalten mit Ordnerinhalt vergleichen

Array aus Excel Tabelle einlesen Word VBA

Dynamische Tabellen mit automatischer Aktualisierung

(Excel) Dynamische Tabelle, VBA, fehlende Formatierung?

Speichern mit dem Titel der Zelle A2

Excel VBA - Code Hilfe (Spalten, Werte kopieren etc.)