NotesRichTextItem- Tabelle wird nicht angezeigt

[bikerboy]

Hallo,

meinen Finger ist heute eine Funktion entglitten, die in einem Notes RichtextItem, eine Tabelle generieren soll.

Ich hatte eine solche Funktion schon mal gebaut und grösstenteils Copy& Paste betrieben, aber es funktioniert nicht.

Ausgangssituation:

Ich habe ein neues Dokument in dem eine Tabelle generiert werden soll.

Hier der Code :

Code

Sub Click(Source As Button)
	Dim s As New NotesSession
	Dim ws As New NotesUIWorkspace
	
	Dim dbDHAdr As NotesDatabase
	
	Dim colDocsAssets As NotesDocumentCollection
	
	Dim docAsset As NotesDocument
	Dim docThis As NotesDocument
	
	Dim uidoc As NotesUIDocument
	
	Dim rtList As NotesRichTextItem
	Dim rtListStyle As NotesRichTextStyle
	Dim rtTablePosition As NotesRichTextNavigator
	Dim rtTable As NotesRichTextTable
	
	Dim strDBDHAdrServer As String
	Dim strDBDHAdrPath As String
	Dim strAdrSearchKey As String
	
	Dim iColumns As Integer
	Dim iRows As Integer
	
	
	Set docThis = ws.currentdocument.document
	Set uidoc = ws.CurrentDocument
	
	Call docThis.Save(1,0,0)
	strDBDHAdrServer = docThis.GetItemValue("DHAdrServer")(0)
	strDBDHAdrPath = docThis.GetItemValue("DHAdrPath")(0)
	strAdrSearchKey = docThis.GetItemValue("AdrAddressSearchKey")(0)
	
	Set dbDHAdr = s.GetDatabase(strDBDHAdrServer,strDBDHAdrPath,False)
	
	If Not dbDHAdr.IsOpen Then
		Call dbDHAdr.Open(strDBDHAdrServer,strDBDHAdrPath)
	End If
	
	If dbDHAdr.IsOpen Then
		' Gucken ob es Potenziale zu dieser Firma gibt
		Set colDocsAssets = dbDHAdr.Search({Form = "frmPotenzial" & AdrSearchKey = "} +strAdrSearchKey + {"},Nothing , 0)
		
		If colDocsAssets.Count = 0 Then
			Print { Es wurden keine Dokumente gefunden}
			Exit Sub
		End If
		
		' Vorbereiten der Tabelle
		' greifen des Item
		
		Call docThis.RemoveItem("rtAssetsList")
		Set rtList = New NotesRichTextITem(docThis,"rtAssetsList")
		Set rtListStyle = s.CreateRichTextStyle()
		
		rtListStyleBold = False
		rtListStyle.FontSize = 9
		rtListStyle.NotesFont = rtList.GetNotesFont("Verdana", True)
		rtListStyle.NotesColor = COLOR_BLACK
		' erstellen der Tabelle
		
		iColumns = 7
		iRows = 1
		
		Call rtList.AppendStyle(rtListStyle)
		Call rtList.AppendTable(iRows,iColumns,True)
		
		Set rtTablePosition = rtList.CreateNavigator()
		rtTablePosition.FindLastElement RTELEM_TYPE_TABLE
		Set rtTable = rtTablePosition.GetElement
		
		rtTablePosition.FindNextElement RTELEM_TYPE_TABLECELL
		
		' schreiben des Titels
		
		rtList.BeginInsert rtTablePosition
		rtList.AppendText "Anzahl"
		rtList.EndInsert
		
		rtTablePosition.FindNextElement
		rtList.BeginInsert rtTablePosition
		rtList.AppendText "Gerätekategorie"
		rtList.EndInsert
		
		rtTablePosition.FindNextElement
		rtList.BeginInsert rtTablePosition
		rtList.AppendText "Geräteanzahl"
		rtList.EndInsert
		
		rtTablePosition.FindNextElement
		rtList.BeginInsert rtTablePosition
		rtList.AppendText "Geräteanzahl im IV"
		rtList.EndInsert
		
		rtTablePosition.FindNextElement
		rtList.BeginInsert rtTablePosition
		rtList.AppendText "Dienstleiste IV"
		rtList.EndInsert
		
		rtTablePosition.FindNextElement
		rtList.BeginInsert rtTablePosition
		rtList.AppendText "Vertragslaufzeiten IV"
		rtList.EndInsert
		
		rtTablePosition.FindNextElement
		rtList.BeginInsert rtTablePosition
		rtList.AppendText "Anzahl der Geräte auf Z&M"
		rtList.EndInsert
		
		rtTablePosition.FindNextElement
		rtList.BeginInsert rtTablePosition
		rtList.AppendText "Dienstleister Z&M"
		rtList.EndInsert
		
				' schreiben des Inhaltes 
		
		Set docAsset = colDocsAssets.GetFirstDocument
		
		For i = 1 To colDocsAssets.Count
			Call rtTable.AddRow
			
			rtTablePosition.FindNextElement
			rtList.BeginInsert rtTablePosition
			rtList.AppendText Cstr(docAsset.GetItemValue("potCategory")(0))
			rtList.EndInsert
			
			rtTablePosition.FindNextElement
			rtList.BeginInsert rtTablePosition
			rtList.AppendText Cstr(docAsset.GetItemValue("potAssetsTotal")(0))
			rtList.EndInsert
			
			rtTablePosition.FindNextElement
			rtList.BeginInsert rtTablePosition
			rtList.AppendText Cstr(docAsset.GetItemValue("potAssetsIV")(0))
			rtList.EndInsert
			
			rtTablePosition.FindNextElement
			rtList.BeginInsert rtTablePosition
			rtList.AppendText Cstr(docAsset.GetItemValue("potProvider")(0))
			rtList.EndInsert
			
			rtTablePosition.FindNextElement
			rtList.BeginInsert rtTablePosition
			rtList.AppendText Cstr(docAsset.GetItemValue("potDuration")(0))
			rtList.EndInsert
			
			rtTablePosition.FindNextElement
			rtList.BeginInsert rtTablePosition
			rtList.AppendText Cstr(docAsset.GetItemValue("potAssetsZM")(0))
			rtList.EndInsert
			
			rtTablePosition.FindNextElement
			rtList.BeginInsert rtTablePosition
			rtList.AppendText Cstr(docAsset.GetItemValue("potProviderZM")(0))
			rtList.EndInsert
			
			Set docAsset = colDocsAssets.GetNextDocument(docAsset)	
		Next
		
		Call docThis.Save(True,False,False)
		
		
	End If
End Sub

Die Tabelle bleibt , leider im Nirvana. im Debugger sehe ich sie aber.

[DerAndre]

Rich Text lässt Grußen.

UiDoc zu und wieder auf.

[bikerboy]

Gut jetzt muss ich erstmal gucken ,dass mir dochouse nicht immer dazwischen funkt, der unterbricht immer mein reopen