Sub Body
'---- Declaration of Notes elements ----
Dim ws As New NotesUIworkspace
Dim session As New NotesSession
Dim uidoc As NotesUIdocument
Dim doc As Notesdocument
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
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