Es muss nicht immer WinWord sein! Mit diesem Beispiel erstellen Sie im Handumdrehen Ihre eigene Serienbrief-Druckfunktion. Alles, was Sie benötigen ist ein RichTextEdit - Control. Den Text selbst erstellen Sie am einfachsten mit Microsoft WordPad. Hier lassen sich auch Schriftattribute und Schriftarten selbst verwenden, so dass der Serienbrief nicht ganz so "triste" aussieht. Eine Serienbrief-Druckfunktion wäre keine wirkliche Serienbrief-Druckfunktion, wenn nicht automatisch bestimmte Platzhalter im Dokument mit den entsprechenden Daten ersetzt werden würden. Also fügen Sie beim Erstellen des Dokuments einfach die benötigten Platzhalter ein, z.B. in der Form #BRIEFANRED#, #DATUM#, #NAME# usw. Wichtig ist jetzt noch, dass Sie Ihre Serienbrief-Vorlage als RTF-Dokument abspeichern - also nicht im DOC-Format! Serienbrief-Druckfunktion Und dass der Anwender nicht merkt, dass wir unsere Serienbrief-Druckfunktion über ein RTF-Control realisieren, setzen wir die Eigenschaft Visible = False. Nachfolgend zunächst die Routine zum Ersetzen eines Platzhalter mit den entsprechenden Daten. Hierbei "bedienen" wir uns der Find-Methode des RTF-Elements. Die Suche nach dem Platzhalter beginnt von vorne und wird solange fortgesetzt, bis alle Platzhalter ein- und desselben Typs ersetzt wurden. ' Bestimmten Platzhalter im RTF-Control mit den ' entsprechenden Daten ersetzen Private Sub strReplace(ByVal sPlatzhalter As String, _ ByVal SDaten As String, _ Optional ByVal lColor As Long = 0, _ Optional ByVal bBold As Boolean = False) ' Platzhalter im RTF-Feld ersetzen Dim lPos As Long Dim curPos As Long With rtfPrint curPos = .SelStart lPos = 0 Do ' Nach Platzhalter suchen lPos = .Find(sPlatzhalter, lPos) If lPos >= 0 Then ' Ggf. Textattribute verwenden If lColor <> 0 Then .SelColor = lColor If bBold Then .SelBold = True .SelText = SDaten lPos = lPos + Len(sPlatzhalter) End If Loop Until lPos < 0 .SelStart = curPos .SelLength = 0 End With End Sub In der Parameterliste lässt sich neben dem Platzhalter und den Daten zusätzlich noch angeben, ob die "einzusetzenden" Daten fett und in einer bestimmten Farbe hervorgehoben werden sollen. Fehlt jetzt nur noch die Druckroutine... ' Vorlage laden und Platzhalter ersetzen Screen.MousePointer = 11 With rtfPrint ' Dokument laden (ggf. Pfad anpassen) .LoadFile App.Path & "\Brief.rtf" End With ' Platzhalter ersetzen strReplace "#BRIEFANREDE", sBriefanrede strRepalce "#DATUM"#, Format$(Now, "dd.mm.yy") strReplace "#NAME#", sName ' Und losdrucken ;-) rtfPrint.SelPrint Printer.hDC Screen.MousePointer = 0 Die Variablen sBriefanrede und sName müssen natürlich vor dem Druckvorgang mit den entsprechenden Daten "gefüllt" werden. Ein Anwendungsbeispiel Serienbrief-Vorlage #ANREDE# #VORNAME# #NAME# #STRASSE# #PLZ# #ORT# #HEUTE# NEU! DIE VB@RCHIV CDROM VOL.1 #BRIEFANREDE# wir freuen uns Ihnen mitteilen zu können, dass unsere erste offizielle <a href="http://www.vbarchiv.net/home/vbcdvol1.php" target="_blank">vb@rchiv CDROM</a> ab sofort erhältlich ist! Auf der CD finden Sie folgende Inhalt... ... ... ... ... Mit den besten Grüßen, Ihr vb@rchiv Team Speichern Sie die Vorlage im Anwendungsverzeichnis Ihrer Anwendung ab, z.B. unter Brief.rtf Und hier ist Ihre Serienbrief-Druckfunktion Private Sub mnuSerienDruck_Click() Dim Db As Database Dim Rs As Recordset ' Datenbank öffnen Set Db = OpenDatabase("KUNDEN.MDB", False, False) Set Rs = Db.OpenRecordset("Kunden") ' Alle Kunden berücksichtigen Do With rtfPrint ' Dokument laden (ggf. Pfad anpassen) .LoadFile App.Path & "\Brief.rtf" End With ' Platzhalter ersetzen ' Briefanrede fett hervorheben strReplace "#BRIEFANREDE", Briefanrede(Rs("Anrede"), Rs("Name")), , True ' Anschrift einsetzen strReplace "#ANREDE#", Rs("Anrede") strReplace "#NAME#", Rs("Name") strReplace "#VORNAME#", Rs("Vorname") strReplace "#STRASSE#", Rs("Strasse") strReplace "#PLZ#", Rs("PLZ") strReplace "#ORT#", Rs("Ort") ' Tagesdatum strRepalce "#HEUTE#", Format$(Now, "dd.mm.yy") ' Und losdrucken ;-) rtfPrint.SelPrint Printer.hDC ' Nächster Kunde Rs.MoveNext Loop Until Rs.Eof ' Datenbank schliessen Rs.Close Db.Close Set Db = Nothing End Sub ' Kleine Hilfsroutine für das korrekte ' Ermitteln der Briefanrede Private Function Briefanrede(ByVal sAnrede As String, _ ByVal sName As String) As String Select Case UCase$(sAnrede) Case "HERR", "HERRN" Briefanrede = "Sehr geehrter Herr " & sName & "," Case "FRAU" Briefanrede = "Sehr geehrte Frau " & sName & "," Case Else Briefanrede = "Sehr geehrte Damen und Herren," End Select End Function Hätten Sie gedacht, dass sich eine eigene Serienbrief-Druckfunktion so einfach realisieren lässt? |