Hallo zusammen,
ich erstelle per vba Serienbriefe, was soweit ganz prima funktioniert. Leider habe ich noch das Problem, dass eine Menge leere Serienbriefe gedruckt werden, in den die Merge-Felder leer sind, weil die Zellen der Datenquelle keine Inhalte haben.
Wie kann ich Excel bzw. Word dazu überreden, beim letzten Zelleninhalt der Datenquelle keine Serienbriefe mehr zu erstellen?
Hier das Makro um die Datenquelle zu füllen:
Die mit ' markierten teile haben leider keinen Erfolg gebracht...
Sub dqfuellen()
Sheets("Testsheet").Range("Z1:AY30").Copy
Application.WindowState = xlMinimized
Workbooks.Open Filename:="H:\XX\DQ-KBV-SB.xlsx"
With ActiveSheet
.Range("A1").PasteSpecial Paste:=xlValues
'Selection.SpecialCells(xlCellTypeConstants, 23).Select
'.Range("A1", Range("Z65536").End(xlUp)).Select
'ActiveSheet.UsedRange.Select
'For Each zelle In Selection
'If zelle.Text = "" Then
'zelle.EntireRow.Delete
'ActiveSheet.UsedRange.Select
'End If
'Next
End With
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.WindowState = xlMaximized
Call Serienb4
end sub
VBA für Serienbriefe:
Sub Serienb4()
Dim winword, WinDoc As Word.Document, docSerienbrief As Word.Document
Dim sFile As String, strCon As String
sFile = strWOrdvorlage
Set winword = CreateObject("Word.Application")
With winword
.Visible = True
'Vorlagedatei öffnen
Set WinDoc = .Documents.Open(sFile)
With WinDoc
With .MailMerge
'Datenquelle öffnen
.OpenDataSource Name:=strDatenQuelle, _
Connection:="Provider=Microsoft.Jet.OLEDB.4.0;" _
& "Data Source=" & strDatenQuelle & ";" _
& "Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";" _
& "Jet OLEDB:Engine ", _
SQLStatement:="SELECT * FROM `Tabelle1$`"
'Serienbrief mit allen Daten in neuem Dokument erstellen
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord
End With
.Execute Pause:=False
Set docSerienbrief = winword.ActiveDocument
'Datenquelle wieder schliessen
.DataSource.Close
End With
'Vorlagedatei wieder schliessen
.Close savechanges:=False
End With
'Serienbrief - Drucken - Seitenvorschau
docSerienbrief.Application.WindowState = wdWindowStateMinimize
If MsgBox("Serienbrief Drucken ?", vbYesNo + vbQuestion, _
"Serienbrief-Erstellung - Drucken - Seitenvorschau") = vbYes Then
docSerienbrief.Application.WindowState = wdWindowStateMaximize
'docSerienbrief.PrintPreview
docSerienbrief.PrintOut
End If
'Serienbrief - Speichern
docSerienbrief.Application.WindowState = wdWindowStateMinimize
If MsgBox("Serienbrief Speichern ?", vbYesNo + vbQuestion, _
"Serienbrief-Erstellung-Speichern") = vbYes Then
docSerienbrief.Application.WindowState = wdWindowStateMaximize
docSerienbrief.Application.Dialogs(wdDialogFileSaveAs).Show
Else: Exit Sub
End If
'docSerienbrief.Application.WindowState = wdWindowStateMaximize
End With
winword.Quit savechanges:=False
Set docSerienbrief = Nothing
Set winword = Nothing
Set WinDoc = Nothing
End Sub