Unterschiede
Hier werden die Unterschiede zwischen zwei Versionen angezeigt.
Beide Seiten der vorigen Revision Vorhergehende Überarbeitung Nächste Überarbeitung | Vorhergehende Überarbeitung | ||
hylafax:vba-makro_word_und_whfc [2007/03/27 14:41] – st | hylafax:vba-makro_word_und_whfc [2007/12/04 04:17] (aktuell) – st | ||
---|---|---|---|
Zeile 1: | Zeile 1: | ||
+ | ====== VBA-Makro für Seriendruck mit Word und WHFC ====== | ||
+ | Vorrausgesetzt wird eine funktionierende Installation von [[http:// | ||
+ | |||
+ | ===== Hinweise ===== | ||
+ | * Word zeigt immer eine Seite nach der letzte Seite an, obwohl eine Felder angezeigt und diese Seite auch nicht ausgedruckt wird. Deshalb kommt am Ende eine Fehlermeldung, | ||
+ | |||
+ | |||
+ | |||
+ | |||
+ | ===== Code ===== | ||
+ | |||
+ | <code vb> | ||
+ | Function Sonderzeichen_raus(ZeichenKette As String) | ||
+ | ' löscht bzw. ersetzt die Sonderzeichen | ||
+ | ZeichenKette = Replace(ZeichenKette, | ||
+ | ZeichenKette = Replace(ZeichenKette, | ||
+ | ZeichenKette = Replace(ZeichenKette, | ||
+ | ZeichenKette = Replace(ZeichenKette, | ||
+ | ZeichenKette = Replace(ZeichenKette, | ||
+ | ZeichenKette = Replace(ZeichenKette, | ||
+ | ZeichenKette = Replace(ZeichenKette, | ||
+ | ZeichenKette = Replace(ZeichenKette, | ||
+ | ZeichenKette = Replace(ZeichenKette, | ||
+ | Sonderzeichen_raus = ZeichenKette | ||
+ | |||
+ | End Function | ||
+ | |||
+ | |||
+ | Sub SerienFax() | ||
+ | ' | ||
+ | ' | ||
+ | ' SerienFax Macro | ||
+ | ' Dieses Makro erstellt Serienfaxe auf Basis eines Word-Seriendruckdokumentes | ||
+ | ' Es basiert auf einem Macro von Keith Gray, | ||
+ | ' und wurde angepasst von Detlev Reymann am 22.3.99 | ||
+ | ' weitere Anpassung Stefan Kuchling 2007 (Sonderzeichen_raus: | ||
+ | |||
+ | ' Variablen definieren | ||
+ | Dim whfc As Object | ||
+ | Dim OLE_Return As Long | ||
+ | Dim FaxNummer As String | ||
+ | Dim SpoolFile As String | ||
+ | Dim Title As String | ||
+ | Dim WhfcPrinter As String | ||
+ | Dim NbrOfFields As Integer | ||
+ | Dim j As Integer | ||
+ | Dim TelefaxNrFeld As Integer | ||
+ | Dim Ergebnis As Integer | ||
+ | Dim NmbOfFaxes As Integer | ||
+ | |||
+ | ' Damit das Makro funktioniert muß das aktive Dokument ein Serienbriefhauptdokument sein | ||
+ | ' und es muß eine Datei mit den Datensätzen definiert sein. | ||
+ | ' Das wird im folgenden überprüft | ||
+ | If ActiveDocument.MailMerge.State <> wdMainAndDataSource Then | ||
+ | Ergebnis = MsgBox(" | ||
+ | Exit Sub | ||
+ | End If | ||
+ | |||
+ | ' Feststellen wieviele Faxe geschickt werden sollen | ||
+ | ' Dazu Nummer des letzten Datensatzes feststellen | ||
+ | ActiveDocument.MailMerge.DataSource.ActiveRecord = wdLastRecord | ||
+ | NmbOfFaxes = ActiveDocument.MailMerge.DataSource.ActiveRecord | ||
+ | |||
+ | ' Ersten Datensatz zum aktiven Datensatz machen | ||
+ | ActiveDocument.MailMerge.DataSource.ActiveRecord = wdFirstRecord | ||
+ | |||
+ | ' Feststellen, | ||
+ | ' Das sollte es möglich machen, an beliebiger Stelle ein Feld | ||
+ | ' für die Telefaxnummer zu definieren. es muß nur der Text | ||
+ | ' fax in der Feldbezeichnung vorkommen. | ||
+ | ' Es müßte also auch Telefax-Nr funktionieren | ||
+ | NbrOfFields = ActiveDocument.MailMerge.DataSource.DataFields.Count | ||
+ | ' j speichert die Feldnummer | ||
+ | For j = 1 To NbrOfFields | ||
+ | If InStr(1, ActiveDocument.MailMerge.DataSource.DataFields(j).Name, | ||
+ | TelefaxNrFeld = j | ||
+ | Exit For | ||
+ | End If | ||
+ | Next j | ||
+ | |||
+ | ' Wenn kein Datenfeld für die Faxnummer gefunden wurde | ||
+ | ' das Makro abbrechen | ||
+ | If j > NbrOfFields Then | ||
+ | Ergebnis = MsgBox(" | ||
+ | Exit Sub | ||
+ | End If | ||
+ | |||
+ | ' OLE-Verbindung zu WHFC herstellen | ||
+ | Set whfc = CreateObject(" | ||
+ | |||
+ | ' Jetzt in einer Schleife die Faxe drucken | ||
+ | Dim i As Integer | ||
+ | For i = 1 To NmbOfFaxes | ||
+ | ' Für jedes einzelne Fax eine temporäre Datei | ||
+ | ' Hier muß ggf. wieder der Pfad angepaßt werden | ||
+ | SpoolFile = " | ||
+ | Title = "WHFC OLE Serienfaxmakro" | ||
+ | |||
+ | ' Die aktualisierten Datenfelder anzeigen | ||
+ | ' Das ermöglicht die Verwendung der Seriendruckfelder im Hauptdokument | ||
+ | ' und sorgt dafür, daß die korrekten Werte des aktiven Records | ||
+ | ' angezeigt werden | ||
+ | ActiveWindow.View.ShowFieldCodes = False | ||
+ | ActiveWindow.View.MailMergeDataView = True | ||
+ | |||
+ | ' Die Faxnummer aus dem Feld nehmen, daß oben ermittelt wurde | ||
+ | FaxNummer = CStr(ActiveDocument.MailMerge.DataSource.DataFields(j)) '## | ||
+ | | ||
+ | ' evtuelle Sonderzeichen aus der FaxNummer nehmen (Funktion Sonderzeichen_raus aufrufen) | ||
+ | FaxNummer = Sonderzeichen_raus(FaxNummer) | ||
+ | |||
+ | ' Fax nur schicken, wenn Faxnummer eingetragen ist | ||
+ | If FaxNummer > "" | ||
+ | |||
+ | ' | ||
+ | If IsNumeric(FaxNummer) Then | ||
+ | |||
+ | ' Einen Postscriptdrucker als Drucker festlegen | ||
+ | ' Achtung !!!!!!!!!!!!!!!!!!!!!!!!! | ||
+ | ' Hier muß ggf. der eigene Postscriptdrucker eingetragen werden | ||
+ | ' Ich hatte hier Probleme, den WHFC-Drucker zu verwenden und habe | ||
+ | ' extra einen Postscriptdrucker mit Ausgabe in eine Datei definiert | ||
+ | WhfcPrinter = "WHFC Fax" | ||
+ | 'oder z.B. Apple Color LW 12/600 PS" | ||
+ | ActivePrinter = WhfcPrinter$ | ||
+ | |||
+ | ' Jeweils das ganze Dokument drucken | ||
+ | Application.PrintOut FileName: | ||
+ | Item: | ||
+ | PageType: | ||
+ | PrintToFile: | ||
+ | |||
+ | ' Mit diesem Kommando wird das jeweilige Fax an WHFC übergeben und von | ||
+ | ' diesem an den Faxserver weitergeleitet. | ||
+ | OLE_Return = whfc.SendFax(SpoolFile, | ||
+ | ' Falls das nicht klappt, Fehlermeldung | ||
+ | If OLE_Return <= 0 Then | ||
+ | Ergebnis = MsgBox(" | ||
+ | End If | ||
+ | |||
+ | End If | ||
+ | End If | ||
+ | ' Nächsten Datensatz holen | ||
+ | ActiveDocument.MailMerge.DataSource.ActiveRecord = wdNextRecord | ||
+ | Next i | ||
+ | |||
+ | Set whfc = Nothing | ||
+ | ' Wieder Standarddrucker einstellen | ||
+ | ' Auch hier bitte den eigenen Standarddrucker eintragen | ||
+ | ActivePrinter = " | ||
+ | End Sub | ||
+ | |||
+ | </ | ||
+ | |||
+ | [[http:// |