Formatierungen aus RichText-Feld beim Kopieren beibehalten

[Wiesel]

Hallo!
Ich habe in einer Datenbank die Möglichkeit Dokumente als Vorlage zu generieren.
Wenn diese Vorlage nun genutzt werden soll, kann über eine Schaltfläche eine Kopie zum "Echteinsatz" erstellt werden.
RichText-Felder verlieren dann aber jegliche Formatierung.
Wie kann ich das verhindern?

Hier mal mein Script:
Die Zeile "NewDoc.txtVorlage = doc.GetItemValue("txtVorlage")" ist das RichText-Feld

Sub Click(Source As Button)
   Dim S As New NotesSession
   Dim DB As NotesDatabase   
   Dim NewDoc As NotesDocument
   Dim Doc As NotesDocument
   Dim WS As New NotesUIWorkspace
   Dim UIDoc As NotesUIDocument
   
   'Neues Dokument erstellen
   Set DB = S.CurrentDatabase
   Set NewDoc = DB.CreateDocument
   NewDoc.Form = "mskDok"
   
   Set UIDoc = WS.CurrentDocument
   Set Doc = UIDoc.Document
   
   'Felder übertragen
   NewDoc.txtStatus = "in Arbeit"
   NewDoc.txtVorlage = doc.GetItemValue("txtVorlage")
      
   'Dokument zum Bearbeiten anzeigen
   Call WS.EditDocument(True,NewDoc)
   
   Call UIDoc.save
   Call UIDoc.Close
   
End Sub


Und bei diesem Script habe ich das selbe Problem mit dem RichText-Feld doc2.txtVorlage :

Sub ProtokollDruck()
   Dim workspace As New NotesUIWorkspace
   Dim db As NotesDatabase
   Dim session As New NotesSession
   Dim uidoc As NotesUIDocument
   Dim doc As NotesDocument
   Dim Newdoc As NotesDocument
   Dim col As NotesDocumentCollection
   Dim doc2 As NotesDocument
   Dim view As NotesView
   Dim strAntwortdoc As String
   Dim strNr As Variant
      
   Set db = session.CurrentDatabase
   Set doc = session.DocumentContext
   
   If doc.form(0) = "mskDok2" Then
      
      'Neues Dokument erstellen
      Set Newdoc = DB.CreateDocument
      Newdoc.form = "(DruckDok2)"
      Newdoc.datSitzung = doc.datSitzung (0)
      Newdoc.datBeginn = doc.datBeginn (0)
      Newdoc.datEnde =doc.datEnde(0)
      
      strNr = doc.GetItemValue( "numNiederschrift" )
      
      Set view = DB.GetView("(BVorlage)")
      Set col = view.getalldocumentsbykey(strNr)
      Set doc2 = col.GetFirstDocument
      
      strAntwortdoc = ""
      Do  Until doc2 Is Nothing
                                    
            strAntwortdoc =    strAntwortdoc & _
            Chr(13) & Chr(13) & _
            Chr(13) & Chr(13) & _
            "   " & doc2.numBeschluss(0) & " " & doc2.txtBetreff(0) &_
            Chr(13) & _
            "   " & Chr(13) & "   " & doc2.txtVorlage & Chr(13)
         
         strBereich = doc2.optPBereich(0)
         Set doc2 = col.GetNextDocument(doc2)
      Loop
      
      'Antwortdokumente in Druck unterbringen
      Newdoc.txtBeschlussvorlage = strAntwortdoc
      Newdoc.datAusdruck = Cstr(Today())
      'Dokument zum Bearbeiten anzeigen
      Call workspace.EditDocument(True,Newdoc)
      
   End If   
   
End Sub


Grüße,
Wiesel

[Bogdanovs]

Hallo!

Was du brauchst, ist das hier:

   Dim rtNewItem As notesRichtextItem
   Dim rtExistingItem As notesRichTextItem
   
   
   Set rtExistingItem = doc.getFirstItem("txtVorlage")
   Set rtNewItem = New notesRichTextItem(newDoc, "txtVorlage")
   Call rtNewItem.AppendRTItem(rtExistingItem)
   Call rtNewItem.Compact
   Call rtNewItem.Update
   
   Call ws.EditDocument(True, newDoc)   

[Wiesel]

Bei dem ersten Script klappt das auch super! Danke!

Aber ich rätsel noch, wie ich das in den zweiten Script reinpacke. Das ist das Richtextfeld ja mitten in einer Variablen, die ich mir zusammensetze aus unterschiedlichen Feldern....

[Bogdanovs]

Ich denke, auch das kann gemacht werden. Um Zeichenketten im RichText zu ersetzen brauchst du ein NotesRichTextRange benützen.

Dim rtrange As NotesRichTextRange

Set rtrange = rtNewItem.CreateRange
While rtrange.FindAndReplace ("whatToFind", "replacedWiththis", RT_FIND_CASEINSENSITIVE) > 0      
   Call rtNewItem.update
Wend   

[Wiesel]

Oje, das ist für mich jetzt aber schwierig...
Außerdem ist in meinem Script nur das eine Feld ein RichText. Und in dem neuen Dokument wird das RichText-Feld und andere Felder zusammengelegt. Wie behalte ich da die Formatierung in der Schleife bei?

Hier nochmal ein Ausschnitt (doc2.txtVorlage ist das RichText-Feld):

strAntwortdoc = ""
      Do  Until doc2 Is Nothing
                     
            strAntwortdoc =    strAntwortdoc & _
            Chr(13) & Chr(13) & _
            Chr(13) & Chr(13) & _
            "   " & doc2.numBeschluss(0) & " " & doc2.txtBetreff(0) &_
            Chr(13) & _
            "   " & Chr(13) & "   " & doc2.txtVorlage  & Chr(13)  & Chr(13)  & strPR & _
            Chr(13) & Chr(13) & "________________________________________________________________"
         
         strBereich = doc2.optPBereich(0)
         Set doc2 = col.GetNextDocument(doc2)
      Loop

[Bogdanovs]

Ich denke, das hier muss funktionieren:

   Dim rtNewItem As notesRichtextItem
   
'.......
   
   
   Set rtNewItem = New notesRichTextItem(newDoc, "txtVorlage")
   
   Dim rtExistingItem As notesRichTextItem
   Do  Until doc2 Is Nothing   
      rtNewItem.addNewLine(2)
      rtNewItem.AppendText(" " & doc2.numBeschluss(0) & " " & doc2.txtBetreff(0) &_
      Chr(13) & _
      "   " & Chr(13) & "   ")
      
      If doc2.hasItem("txtVorlage") Then
                       
         Set rtExistingItem = doc2.getFirstItem("txtVorlage")
         Call rtNewItem.AppendRTItem(rtExistingItem) '<- rich text inhalt aus doc2 wird hier hizufugt
      End If

      rtNewItem.addNewLine(1)                 
      rtNewItem.AppendText("__________________________________")      
      rtNewItem.addNewLine(1)
      
   '............
      
      Set doc2 = col.GetNextDocument(doc2)
   Loop
   
   
'....
   
   
   Call rtNewItem.Compact
   Call rtNewItem.Update
   
   Call workspace.EditDocument(True,Newdoc)   

[Wiesel]

Danke für die schnelle Antwort.
Kriege ein Type Mismatch und komme erst gar nicht mit dem Debugger rein (
Außerdem fehlt mir dabei die Zusammensetzung über mein strAntwort...damit kriege ich das gar nicht hin....
Gibt es überhaupt eine Lösung für mein Problem???

[Bogdanovs]

Ergänze bitte die funktion mit solche Kode. Dann werden wir wissen welche Zeile verursacht das Fehler.

Sub ProtokollDruck()

on error goto erh
dim rtExistingItem as notesRichTextItem

.......

exit sub
erh:
   Messagebox Error$ + " at line "  + cstr(erl)
exit sub
end sub

Copiere bitte auch die Ganze Funktion hier.

[Michael Kl]

Das klappt super!

Hallo!

Was du brauchst, ist das hier:

   Dim rtNewItem As notesRichtextItem
   Dim rtExistingItem As notesRichTextItem
   
   
   Set rtExistingItem = doc.getFirstItem("txtVorlage")
   Set rtNewItem = New notesRichTextItem(newDoc, "txtVorlage")
   Call rtNewItem.AppendRTItem(rtExistingItem)
   Call rtNewItem.Compact
   Call rtNewItem.Update
   
   Call ws.EditDocument(True, newDoc)