Domino 9 und frühere Versionen > ND6: Entwicklung

programatische Tabellenerstellung

<< < (4/4)

m3:
Zwei Felder, zwei Inhalte.

Ich würde an Deiner Stelle mal versuchen, das Problem einzugrenzen. Kommentier den ganzen Tabellenschmonzes mal aus und versuch, in die Felder nur Text zu schreiben (siehe mein Beispiel). Wenn das funktioniert, bohr den Code schrittweise wieder auf.

bikerboy:
@m3

habe mal blind deinen Code kopiert..... ist super zum Clientabschiessen. (nicht böse gemeint), Werde mir das ganze nochmal in Ruhe an einem anderen Tag angucken, wenn nicht gibt es halt 2 Knöpfe.

Ich bedanke mich bei allen die geholfen haben, falls ihr noch Ideen oder so habt einfach posten ich werde sie alle aufnehmen.

DerAndre:
Den Code blind kopieren und dann meckern. Tsetsetse...
Aber bei dieser einfachen Sache ein Clientcrash? Da würde ich fast eher auf ein Clientproblem tippen.

bikerboy:
Ich krieg hier die Krise, warum geht das nicht. Ich will doch nur 2 Tabelllen aus einem Knopf erstellen. *heul*

bikerboy:
So Leute ich habs,

Die Lösung war so einfach und irrational dass glaube keiner drauf kommen würde. Ich bin auch nur durch Zufall mit der Nase drauf gestossen. Und zwar habe ich bei einer Demonstration für einen Kollegen das
--- Code: ---call body2
--- Ende Code ---
mal ans Ende und mal an den Anfang des Codes geschrieben. Das Ergebnis war, dass mal die 1. Tabelle erstellt wird, mal die 2. Also habe ich in meiner jugendlichen Naiviität den Aufruf mal in die Mitte des Codes geschrieben und BAM er erstellt 2 Tabellen. Der vollständigkeit halber poste ich noch mal den Code :


--- Code: ---Sub Click(Source As Button)


'---- Declaration of Notes elements ----
Set ws = New NotesUIWorkspace
Set session = New NotesSession

Dim rtf As NotesRichTextItem
Dim rtsBold As NotesRichTextStyle
Dim rtsNormal As NotesRichTextStyle
Dim coHead As NotesColorObject
Dim coAlternate As NotesColorObject
Dim rtnPositions As NotesRichTextNavigator
Dim rtnTotal As NotesRichTextNavigator
Dim rtt As NotesRichTextTable
Dim i As Integer
Dim j As Integer

'---- Declaration of table parameters ----
Dim iRowsPositions As Integer
Dim iColumnsPositions 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("body")
Set rtf = New NotesRichTextItem( doc, "body" )

'---- define style of header ----
Set rtsBold = session.CreateRichTextStyle()
rtsBold.Bold = True
rtsBold.FontSize = 9
rtsBold.NotesFont = rtf.GetNotesFont("Verdana", True)
rtsBold.NotesColor = COLOR_BLACK

Set coHead = session.CreateColorObject
Call coHead.SetRGB(225, 225, 225)
Set coAlternate = session.CreateColorObject
Call coAlternate.SetRGB(255, 255, 255)

'---- define style of data ----
Set rtsNormal = session.CreateRichTextStyle()
rtsNormal.Bold = False
rtsNormal.FontSize = 9
rtsNormal.NotesFont = rtf.GetNotesFont("Verdana", True)
rtsNormal.NotesColor = COLOR_BLACK

'---- define numbers of rows and columns ----
iRowsPositions = 2
iColumnsPositions = 6

'---- Configure Styles for columns ----
Dim rtpsColumnsPositions(0 To 5) As NotesRichTextParagraphStyle
For i = 0 To (iColumnsPositions - 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 = TWIPS - (0.10 * TWIPS)
rtpsColumnsPositions(1).RightMargin = 1.5 * TWIPS - (0.11 * TWIPS)
rtpsColumnsPositions(2).RightMargin = 1.5 * TWIPS - (0.11 * TWIPS)
rtpsColumnsPositions(3).RightMargin = 8 * 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 = 12 * TWIPS - (0.11 * TWIPS)
rtpsColumnsTotal(1).RightMargin = 5 * TWIPS - (0.10 * TWIPS)

' define alignment of columns
rtpsColumnsPositions(0).Alignment = ALIGN_CENTER
rtpsColumnsPositions(1).Alignment = ALIGN_RIGHT
rtpsColumnsPositions(2).Alignment = ALIGN_LEFT
rtpsColumnsPositions(3).Alignment = ALIGN_LEFT
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 body2
dblDiscountTotal = Cdbl(doc.totalDiscount(0)) / 100

'##################################

Call rtf.AppendTable(iRowsPositions, iColumnsPositions, , 2 * TWIPS, rtpsColumnsPositions)
Set rtnPositions = rtf.CreateNavigator()
rtnPositions.FindLastElement RTELEM_TYPE_TABLE
Set rtt = rtnPositions.GetElement

rtt.Style = TABLESTYLE_TOP
rtt.SetAlternateColor coAlternate
rtt.SetColor coHead

' write titles
rtf.AppendStyle rtsBold
rtnPositions.FindNextElement RTELEM_TYPE_TABLECELL
rtf.BeginInsert rtnPositions
rtf.AppendText "Pos"
rtf.EndInsert

rtnPositions.FindNextElement
rtf.BeginInsert rtnPositions
rtf.AppendText "Menge"
rtf.EndInsert

rtnPositions.FindNextElement
rtf.BeginInsert rtnPositions
rtf.AppendText "Einheit"
rtf.EndInsert

rtnPositions.FindNextElement
rtf.BeginInsert rtnPositions
rtf.AppendText "Artikelbezeichnung"
rtf.EndInsert

rtnPositions.FindNextElement
rtf.BeginInsert rtnPositions
rtf.AppendText "Einzelpreis"
rtf.EndInsert

rtnPositions.FindNextElement
rtf.BeginInsert rtnPositions
rtf.AppendText "Gesamtpreis"
rtf.EndInsert

' hier bitte die Positionen dazuschreiben

rtf.AppendStyle rtsNormal

For j = 1 To 6
rtnPositions.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 iTaxCount
strTax = varTaxes(i)
varTaxMatrix(i, 0) = Strtoken(strTax, "|", 1)
varTaxMatrix(i, 1) = Strtoken(strTax, "|", 2)
varTaxMatrix(i, 2) = Strtoken(strTax, "|", 3)
varTaxMatrix(i, 3) = "0"
Next

For i = 0 To j
strDataSet = Strright(varDataString(i), "|~|")
dblDiscountPos = 1 - Cdbl(Strtoken(strDataSet, "|#|", 6)) / 100
Call rtt.AddRow

' Pos
rtnPositions.FindNextElement
rtf.BeginInsert rtnPositions
rtf.AppendText Right("000" & Cstr(i + 1), 3)
rtf.EndInsert

' Menge
rtnPositions.FindNextElement
rtf.BeginInsert rtnPositions
rtf.AppendText Strtoken(strDataSet, "|#|", 2)
rtf.EndInsert

' Einheit
rtnPositions.FindNextElement
rtf.BeginInsert rtnPositions
rtf.AppendText Strtoken(strDataSet, "|#|", 3)
rtf.EndInsert

' Artikelbezeichnung
rtnPositions.FindNextElement
rtf.BeginInsert rtnPositions
rtf.AppendText Strtoken(strDataSet, "|#|", 1)
rtf.EndInsert

' Einzelpreis
rtnPositions.FindNextElement
rtf.BeginInsert rtnPositions
dblPosPriceNet = Cdbl(Strtoken(strDataSet, "|#|", 4)) * dblDiscountPos
rtf.AppendText Format(dblPosPriceNet, "#,##0.000")
rtf.EndInsert

' Gesamtpreis
rtnPositions.FindNextElement
rtf.BeginInsert rtnPositions
rtf.AppendText Format(Strtoken(strDataSet, "|#|", 7), "#,##0.00")
rtf.EndInsert

'calculate taxes
strTax = Strleft(Strtoken(strDataSet, "|#|", 5), "|")
For j = 0 To iTaxCount
If (varTaxMatrix(j, 1) = strTax) Then
dblNet = Cdbl(Strtoken(strDataSet, "|#|", 7))
varTaxMatrix(j, 3) = Cstr(Cdbl(varTaxMatrix(j, 3) + dblNet ))
End If
Next j
Next i

' create table for totals
Call rtf.AppendTable(1, 2, , 2 * TWIPS, rtpsColumnsTotal)
Set rtnTotal = rtf.CreateNavigator()
rtnTotal.FindLastElement RTELEM_TYPE_TABLE
Set rtt = rtnTotal.GetElement

rtt.Style = TABLESTYLE_TOP
rtt.SetAlternateColor coAlternate
rtt.SetColor coHead

'---- write totals ----

rtf.AppendStyle rtsNormal
rtnTotal.FindNextElement RTELEM_TYPE_TABLECELL
rtf.BeginInsert rtnTotal
rtf.AppendText "Gesamtsumme in EUR"
rtf.EndInsert

rtnTotal.FindNextElement
rtf.BeginInsert rtnTotal
rtf.AppendText Format(uiDoc.FieldGetText("TotalPriceAllPos"), "#,##0.00")
rtf.EndInsert
' write discount
If dblDiscountTotal <> 0 Then

Call rtt.AddRow

rtf.AppendStyle rtsNormal
rtnTotal.FindNextElement
rtf.BeginInsert rtnTotal
rtf.AppendText "Abzüglich " & Format(Cstr(doc.totalDiscount(0)), "#,##0.00") & "% Rabatt"
rtf.EndInsert

rtnTotal.FindNextElement
rtf.BeginInsert rtnTotal
rtf.AppendText Format(Cdbl(uiDoc.FieldGetText("TotalPriceAllPos")) * dblDiscountTotal, "#,##0.00")
rtf.EndInsert

End If

' write taxes

Call rtt.AddRow
rtnTotal.FindNextElement
rtnTotal.FindNextElement

For j = 0  To iTaxCount

If varTaxMatrix(j,3) <> "0" Then

Call rtt.AddRow

rtf.AppendStyle rtsNormal
rtnTotal.FindNextElement
rtf.BeginInsert rtnTotal
rtf.AppendText "Zuzüglich Mehrwertsteuer " & Format(varTaxMatrix(j,2), "#,##0.00") & "% aus " & Format(Cdbl(varTaxMatrix(j,3)) * (1 - dblDiscountTotal), "#,##0.00")  & " EUR"
rtf.EndInsert

rtnTotal.FindNextElement
rtf.BeginInsert rtnTotal
rtf.AppendText Format(Cdbl(varTaxMatrix(j,3)) * Cdbl(varTaxMatrix(j,2)) / 100 * (1 - dblDiscountTotal), "#,##0.00")
rtf.EndInsert

dblTotal = dblTotal + (Cdbl(varTaxMatrix(j,3)) * Cdbl(varTaxMatrix(j,2)) / 100 * (1 - dblDiscountTotal))

End If

Next

dblTotal = dblTotal + doc.TotalPriceNet(0)

' create table for totals
Call rtf.AppendTable(1, 2, , 2 * TWIPS, rtpsColumnsTotal)
Set rtnTotal = rtf.CreateNavigator()
rtnTotal.FindLastElement RTELEM_TYPE_TABLE
Set rtt = rtnTotal.GetElement

rtt.Style = TABLESTYLE_TOP
rtt.SetAlternateColor coAlternate
rtt.SetColor coHead

rtf.AppendStyle rtsBold
rtnTotal.FindNextElement  RTELEM_TYPE_TABLECELL
rtf.BeginInsert rtnTotal
rtf.AppendText "Rechnungsbetrag in EUR"
rtf.EndInsert

rtnTotal.FindNextElement
rtf.BeginInsert rtnTotal
rtf.AppendText Format(dblTotal, "#,##0.00")
rtf.EndInsert


'##################################
Call doc.Save(True, False)

Reopen = True

Call uidoc.Close() ' close and automatically reopen document (see queryclose event)

End Sub
--- Ende Code ---

Navigation

[0] Themen-Index

[*] Vorherige Sete

Zur normalen Ansicht wechseln