Domino 9 und frühere Versionen > ND6: Entwicklung
programatische Tabellenerstellung
bikerboy:
So hier jetzt noch mal der code für die 2. Tabelle. Damit sollte DerAndre´s Frage geklärt sein
--- Code: ---Sub Body2
'---- Declaration of Notes elements ----
Dim ws As New NotesUIworkspace
Dim session As New NotesSession
Dim uidoc As NotesUIdocument
Dim doc As Notesdocument
Dim rtfm As NotesRichTextItem
Dim rtsBold2 As NotesRichTextStyle
Dim rtsNormalm As NotesRichTextStyle
Dim coHeadm As NotesColorObject
Dim coAlternatem As NotesColorObject
Dim rtnPositionsm As NotesRichTextNavigator
' Dim rtnTotal As NotesRichTextNavigator
Dim rttm As NotesRichTextTable
Dim i As Integer
Dim j As Integer
'---- Declaration of table parameters ----
Dim iRowsPositionsm As Integer
Dim iColumnsPositionsm As Integer
'---- Declaration for Datastring
Dim varDataString As Variant
Dim strDataSet As String
Dim varTaxes As Variant
Dim varTaxMatrix As Variant
Dim strTax As String
Dim iTaxCount As Integer
Dim dblTotal As Double
Dim dblNet As Double
Dim dblDiscountTotal As Double
Dim dblDiscountPos As Double
Dim dblPosPriceNet As Double
'---- Initialisation of variables ----
Set uidoc = ws.Currentdocument
Set doc = uidoc.Document
Call doc.RemoveItem("body2")
Set rtfm = New NotesRichTextItem( doc, "body2" )
'---- define style of header ----
Set rtsBold2 = session.CreateRichTextStyle()
rtsBold2.Bold = True
rtsBold2.FontSize = 9
rtsBold2.NotesFont = rtfm.GetNotesFont("Verdana", True)
rtsBold2.NotesColor = COLOR_BLACK
Set coHeadm = session.CreateColorObject
Call coHeadm.SetRGB(225, 225, 225)
Set coAlternatem = session.CreateColorObject
Call coAlternatem.SetRGB(255, 255, 255)
'---- define style of data ----
Set rtsNormalm = session.CreateRichTextStyle()
rtsNormalm.Bold = False
rtsNormalm.FontSize = 9
rtsNormalm.NotesFont = rtfm.GetNotesFont("Verdana", True)
rtsNormalm.NotesColor = COLOR_BLACK
'---- define numbers of rows and columns ----
iRowsPositionsm = 2
iColumnsPositionsm = 4
'---- Configure Styles for columns ----
Dim rtpsColumnsPositions(0 To 3) As NotesRichTextParagraphStyle
For i = 0 To (iColumnsPositionsm - 1)
Set rtpsColumnsPositions(i) = session.CreateRichTextParagraphStyle
rtpsColumnsPositions(i).LeftMargin = 0
rtpsColumnsPositions(i).FirstLineLeftMargin = 0
rtpsColumnsPositions(i).InterLineSpacing = 0
rtpsColumnsPositions(i).Pagination = 0
rtpsColumnsPositions(i).RightMargin = 0
rtpsColumnsPositions(i).SpacingAbove = 0
rtpsColumnsPositions(i).SpacingBelow = 0
Next
' Dim rtpsColumnsTotal(0 To 1) As NotesRichTextParagraphStyle
' For i = 0 To (2 - 1)
' Set rtpsColumnsTotal(i) = session.CreateRichTextParagraphStyle
' rtpsColumnsTotal(i).LeftMargin = 0
' rtpsColumnsTotal(i).FirstLineLeftMargin = 0
' rtpsColumnsTotal(i).InterLineSpacing = 0
' rtpsColumnsTotal(i).Pagination = 0
' rtpsColumnsTotal(i).RightMargin = 0
' rtpsColumnsTotal(i).SpacingAbove = 0
' rtpsColumnsTotal(i).SpacingBelow = 0
' Next
' define width of columns
rtpsColumnsPositions(0).RightMargin = 1.5 * TWIPS - (0.10 * TWIPS)
rtpsColumnsPositions(1).RightMargin = 1.5 * TWIPS - (0.11 * TWIPS)
rtpsColumnsPositions(2).RightMargin = 8 * TWIPS - (0.11 * TWIPS)
rtpsColumnsPositions(3).RightMargin = 2.5 * TWIPS - (0.11 * TWIPS)
'rtpsColumnsPositions(4).RightMargin = 2.5 * TWIPS - (0.11 * TWIPS)
'rtpsColumnsPositions(5).RightMargin = 2.5 * TWIPS - (0.10 * TWIPS)
'rtpsColumnsTotal(0).RightMargin = 8 * TWIPS - (0.11 * TWIPS)
'rtpsColumnsTotal(1).RightMargin = 5.5 * TWIPS - (0.10 * TWIPS)
' define alignment of columns
rtpsColumnsPositions(0).Alignment = ALIGN_RIGHT ' Anzahl
rtpsColumnsPositions(1).Alignment = ALIGN_LEFT ' Einheit
rtpsColumnsPositions(2).Alignment = ALIGN_LEFT ' Produkt
rtpsColumnsPositions(3).Alignment = ALIGN_RIGHT ' Preis
'rtpsColumnsPositions(4).Alignment = ALIGN_RIGHT
'rtpsColumnsPositions(5).Alignment = ALIGN_RIGHT
' rtpsColumnsTotal(0).Alignment = ALIGN_Left
' rtpsColumnsTotal(1).Alignment = ALIGN_Right
uidoc.Autoreload = False
Call uidoc.Reload
Call uidoc.Save ' needed for new documents, otherwise existing richtext will be lost
'##################################
Call rtfm.AppendTable(iRowsPositionsm, iColumnsPositionsm, , 2 * TWIPS, rtpsColumnsPositions)
Set rtnPositionsm = rtfm.CreateNavigator()
rtnPositionsm.FindLastElement RTELEM_TYPE_TABLE
Set rttm = rtnPositionsm.GetElement
rttm.Style = TABLESTYLE_TOP
rttm.SetAlternateColor coAlternatem
rttm.SetColor coHeadm
' write titles
rtfm.AppendStyle rtsBold2
rtnPositionsm.FindNextElement RTELEM_TYPE_TABLECELL
rtfm.BeginInsert rtnPositionsm
rtfm.AppendText "Anzahl"
rtfm.EndInsert
rtnPositionsm.FindNextElement
rtfm.BeginInsert rtnPositionsm
rtfm.AppendText "Einheit"
rtfm.EndInsert
rtnPositionsm.FindNextElement
rtfm.BeginInsert rtnPositionsm
rtfm.AppendText "Produkt"
rtfm.EndInsert
rtnPositionsm.FindNextElement
rtfm.BeginInsert rtnPositionsm
rtfm.AppendText "Einzelpreis"
rtfm.EndInsert
' hier bitte die Positionen dazuschreiben
rtfm.AppendStyle rtsNormalm
For j = 1 To 6
rtnPositionsm.FindNextElement
Next j
varDataString = doc.posDataString
j = Ubound(varDataString)
varTaxes = doc.Taxes
iTaxCount = Ubound(varTaxes)
Redim varTaxMatrix(0 To iTaxCount, 0 To 3)
For i = 0 To j
strDataSet = Strright(varDataString(i), "|~|")
dblDiscountPos = 1 - Cdbl(Strtoken(strDataSet, "|#|", 6)) / 100
Call rttm.AddRow
' Menge
rtnPositionsm.FindNextElement
rtfm.BeginInsert rtnPositionsm
rtfm.AppendText ("..........")
'rtfm.AppendText Strtoken(strDataSet, "|#|", 2)
rtfm.EndInsert
' Einheit
rtnPositionsm.FindNextElement
rtfm.BeginInsert rtnPositionsm
rtfm.AppendText Strtoken(strDataSet, "|#|", 3)
rtfm.EndInsert
' Artikelbezeichnung
rtnPositionsm.FindNextElement
rtfm.BeginInsert rtnPositionsm
rtfm.AppendText Strtoken(strDataSet, "|#|", 1)
rtfm.EndInsert
' Einzelpreis
rtnPositionsm.FindNextElement
rtfm.BeginInsert rtnPositionsm
dblPosPriceNet = Ccur(Cdbl(Strtoken(strDataSet, "|#|", 4)) * dblDiscountPos)
rtfm.AppendText Format(dblPosPriceNet, "#,##0.000")
rtfm.EndInsert
Next
'##################################
Call doc.Save(True, False)
Reopen = True
Call uidoc.Close() ' close and automatically reopen document (see queryclose event)
End Sub
--- Ende Code ---
m3:
--- Zitat ---Trotzdem geht der Fehler nicht weg.
--- Ende Zitat ---
Und dieser "Fehler" äußert sich nun wie??????
bikerboy:
@M3
naja dass er halt nur eine Tabelle erstellt und zwar die 2.
Wenn ich das 2. Call auskommetiere, dann erstellt er die 1. sauber, ansonsten die 2.
Das komische ist , ich würde es ja noch halbwegsnachvollziehen können , wenn er es in das falsche Feld schreibt. Aber er schreibt es ja in die richtigen. Also in die Feld "body" und "body2"
m3:
Also ein
--- Code: ---Sub Initialize
Call Body
Call Body2
End Sub
Sub Body
Dim ws As New NotesUIworkspace
Dim session As New NotesSession
Dim uidoc As NotesUIDocument
Dim doc As Notesdocument
Dim rtf As NotesRichTextItem
Set uidoc = ws.Currentdocument
Set doc = uidoc.Document
Call doc.RemoveItem("body")
Set rtf = New NotesRichTextItem( doc, "body" )
Call rtf.AppendText("Text im Feld Body")
Call doc.Save(True,False) ' needed for new documents, otherwise existing richtext will be lost
Call rtf.AppendText(" Noch mehr Text im Feld Body")
Call doc.Save(True, False)
Call uidoc.Close()
End Sub
Sub Body2
Dim ws As New NotesUIworkspace
Dim session As New NotesSession
Dim uidoc As NotesUIDocument
Dim doc As Notesdocument
Dim rtf As NotesRichTextItem
Set uidoc = ws.Currentdocument
Set doc = uidoc.Document
Call doc.RemoveItem("body2")
Set rtf = New NotesRichTextItem( doc, "body2" )
Call rtf.AppendText("Text im Feld Body2")
Call doc.Save(True,False) ' needed for new documents, otherwise existing richtext will be lost
Call rtf.AppendText(" Noch mehr Text im Feld Body2")
Call doc.Save(True, False)
Call uidoc.Close() ' close and automatically reopen document (see queryclose event)
End Sub
--- Ende Code ---
bringt genau das erwartete Ergebnis.
Mich verwirrt dieses
--- Code: ---uidoc.Autoreload = False
Call uidoc.Reload
Call uidoc.Save ' needed for new documents, otherwise existing richtext will be lost
--- Ende Code ---
etwas. "Zawos is des guad" (wozu braucht man das)? Ich würde das als sinnlos erachten.
bikerboy:
@m3
Was ist denn jetzt dein erwartetes Ergebnis? Meins wäre 2 felder, 2 tabellen. Und das tritt nicht ein, wenn du natürlich erwartest , dass es nicht geht stimmt ja deine Aussage ;)
Navigation
[0] Themen-Index
[#] Nächste Seite
[*] Vorherige Sete
Zur normalen Ansicht wechseln