01.03.2017, 08:05
(Dieser Beitrag wurde zuletzt bearbeitet: 01.03.2017, 10:15 von WillWissen.
Bearbeitungsgrund: Makro in Codetags gesetzt
)
Guten Morgen zusammen,
folgendes: in einer Excel Datei soll ein Serienbrief erstellt werden, dazu werden Daten von Tabelle 1 in Tabelle 3 übertragen und letztendlich per Button der Serienbrief gestartet.
Die max. Anzahl an Brief ist auf 50 Stück beschränkt. Nachfolgender Code erstellt und öffnet den Serienbrief- Problem hier ist, wenn ich z.B. nur 20 Briefe habe, werden trotzdem 50 Word Blätter angezeigt und es kommt die Meldung, "Feldfehlerberechnung in X bis Y".
Hat Jemand eine Idee, wie man die noch in den Griff bekommen kann, also dass nur die Anzahl ausgeben wird, die auch tatsächlich gebraucht wird?
Viele Grüße
Basti
Hier der Code:
folgendes: in einer Excel Datei soll ein Serienbrief erstellt werden, dazu werden Daten von Tabelle 1 in Tabelle 3 übertragen und letztendlich per Button der Serienbrief gestartet.
Die max. Anzahl an Brief ist auf 50 Stück beschränkt. Nachfolgender Code erstellt und öffnet den Serienbrief- Problem hier ist, wenn ich z.B. nur 20 Briefe habe, werden trotzdem 50 Word Blätter angezeigt und es kommt die Meldung, "Feldfehlerberechnung in X bis Y".
Hat Jemand eine Idee, wie man die noch in den Griff bekommen kann, also dass nur die Anzahl ausgeben wird, die auch tatsächlich gebraucht wird?
Viele Grüße
Basti
Hier der Code:
Code:
Sub Rechnung_erstellen()
'----------------------< fp_Excel_Word_Serienbrief_erstellen() >---------------------
Dim ws As Worksheet
Set ws = ActiveSheet
Dim varRange As Excel.Range
'*diese Funktion oeffnet den Serienbrief BR-Mittelung
Dim sFilename As String
sFilename = ThisWorkbook.Path & "\" & ThisWorkbook.Path & "\" & "Rechnung.docx"
'< check Document >
Dim fs As New FileSystemObject
If fs.FileExists(sFilename) = False Then
MsgBox "Die Datei existiert nicht" & vbCrLf & "Dateiname:" & sFilename, vbCritical, " Rechnung.docx ()"
Exit Sub
End If
'</ check Document >
'< Word starten >
Dim wordApp As Object 'As New Word.Application 'Word-dll
Set wordApp = CreateObject("Word.Application")
wordApp.Visible = True
'</ Word starten >
'< Word Document oeffnen >
'Dim doc As Object
Dim doc As Word.Document 'word-dll
Set doc = CreateObject("Word.Document")
Set doc = wordApp.Documents.Open(sFilename, ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False)
'</ Word Document oeffnen >
Dim wb As Workbook
Set wb = ThisWorkbook
Dim sExcel_Filename As String
sExcel_Filename = ThisWorkbook.FullName
'< Datenquelle einstellen >
'*Datenquelle für den Seriendruck
If wordApp.Build Like "12*" Then
'-< Ist_Office2007 >-
doc.MailMerge.OpenDataSource Name:=sExcel_Filename _
, Connection:="Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & sExcel_Filename & ";Mode=Read;Extended Properties=""HDR=YES;IMEX=1;Jet OLEDB:Eng;TypeGuessRows=0;" _
, SQLStatement:="SELECT * FROM `Adressen`", SQLStatement1:=" WHERE Anschreiben='1'", SubType:=1
'*subtype:=1=wdMergeSubTypeAccess
'-</ Ist_Office2007 >-
Else
'-< Ist_Office2010 >-
doc.MailMerge.OpenDataSource Name:=sExcel_Filename, Connection:="Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & sExcel_Filename
', SQLStatement:="SELECT * FROM 'Adressen$'"
' _
, Connection:="Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & sExcel_Filename & ";Mode=Read;Extended Properties=""HDR=YES;IMEX=1;Jet OLEDB:Eng;TypeGuessRows=0;" _
, SQLStatement:="SELECT * FROM `Adressen`", SQLStatement1:=" WHERE Anschreiben<>''", SubType:=1
'*subtype:=1=wdMergeSubTypeAccess
'-</ Ist_Office2010 >-
End If
'</ Datenquelle einstellen >
'< Serienbrief erzeugen >
If Err.Number = 9 Then
'Fehler Maric... Update()
Err.Clear
doc.MailMerge.Execute
ElseIf Err.Number <> 0 Then
MsgBox "Fehler beim Daten holen Word von Excel." & vbCrLf & Err.Description, vbCritical, " Rechnung.docx ()"
Else
doc.MailMerge.Execute
End If
'</ Serienbrief erzeugen >
'< Hauptdocument schliessen >
doc.Close False
'</ Hauptdocument schliessen >
End Sub