RTF im Praxiseinsatz

Einmal aufteilen, bitte!

Die komplette Funktion zum Aufteilen des RTFDokuments befindet sich in der Prozedur, die das Ereignis Beim Klicken der Schaltfläche cmdBerichtOeffnen des Formulars auslöst (Listing 1).

Private Sub cmdBerichtOeffnen_Click()
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim posStart As Long
Dim posEnd As Long
Dim posEndRTF As Long
Dim i As Integer
Dim strRTF As String
Set db = CurrentDb
db.Execute "DELETE FROM tblRTFTexteTemp", dbFailOnError
Set rst = db.OpenRecordset("tblRTFTexteTemp", dbOpenDynaset)
posStart = 1
posEnd = 1
With Me.ctlRTF2
strRTF = .PlainText
Do While Not posEnd = 0
posEnd = InStr(posStart, strRTF, vbCrLf)
If posEnd = 0 Then
posEndRTF = Len(strRTF) + 1
Else
posEndRTF = posEnd
End If
.SelStart = posStart - 1 - i
.SelLength = posEndRTF - posStart
.Copy
Me.ctlRTF2Temp.SetFocus
Me.ctlRTF2Temp.RTFText = ""
Me.ctlRTF2Temp.Paste
rst.AddNew
rst!RTFTextTemp = Me.ctlRTF2Temp.RTFText
rst.Update
i = i + 1
posStart = posEnd + 2
Loop
End With
DoCmd.OpenReport "rptRTFMitAbsaetzen", View:=acViewPreview
End Sub

Nach der Deklaration der benötigten Variablen löscht die Routine zunächst alle Datensätze der Tabelle tblRTFTexteTemp:

db.Execute "DELETE FROM tblRTFTexteTemp", dbFailOn-Error

Damit ist die im Anschluss erzeugte Datensatzgruppe rst auf Basis derselben Tabelle leer:

Set rst = db.OpenRecordset("tblRTFTexteTemp",dbOpenDynaset)

Die Routine initialisiert dann die beiden Variablen posStart und posEnd jeweils mit dem Wert 1 und speichert den reinen Text des RTF2-Steuerelements mit dem aufzuteilenden RTFDokument in der Variablen strRTF.

Die folgende Do-While-Loop-Schleife durchläuft die Routine so lange, bis die Variable posEnd den Wert 0 enthält. Die Variable enthält ihren Wert über die folgende Anweisung:

posEnd = InStr(posStart, strRTF, vbCrLf)

Diese Anweisung ist sehr wichtig: Sie sucht in der Zeichenkette strRTF nach dem Steuerzeichen vbCrLf, was einem Absatzende entspricht. Findet sie kein passendes Zeichen, ist das Ende des in der Zeichenkette strRTF gespeicherten Textes erreicht. Damit diese Anweisung die Zeichenkette nicht immer wieder von vorne durchsucht, beginnt die Suche jeweils an der durch die Variable posStart festgelegten Position.

Gibt es noch einen Zeilenumbruch, dann wird dessen Position in der Variablen posEndRTF zwischengespeichert, andernfalls erhält diese Variable einen Wert, der der letzten Position der Zeichenkette aus strRTF entspricht:

If posEnd = 0 Then
posEndRTF = Len(strRTF) + 1
Else
posEndRTF = posEnd
End If

Direkt im Anschluss passiert das, was sonst manuell geschehen müsste: Mit den zwei folgenden Methoden des RTF2-Steuerelements markiert die Routine den Text von der aktuellen Position bis zur Position des folgenden Zeilenumbruchs:

SelStart = posStart - 1 - i
.SelLength = posEndRTF - posStart

Die Copy-Methode des RTF2-Steuerelements kopiert dessen Inhalt, und die drei folgenden Anweisungen bereiten das temporäre RTF2-Steuerelement vor und fügen den Inhalt der Zwischenablage dort ein:

Me.ctlRTF2Temp.SetFocus
Me.ctlRTF2Temp.RTFText = ""
Me.ctlRTF2Temp.Paste

Nun fehlt nur noch das Speichern des Inhalts des temporären RTF2-Steuerelements in einem neuen Datensatz der Tabelle tblRTFTexteTemp. Dies erledigen diese drei Anweisungen:

rst.AddNew
rst!RTFTextTemp = Me.ctlRTF2Temp.RTFText
rst.Update