Autor Thema: programatische Tabellenerstellung  (Gelesen 9582 mal)

Offline bikerboy

  • Gold Platin u.s.w. member:)
  • *****
  • Beiträge: 1.155
  • Geschlecht: Männlich
programatische Tabellenerstellung
« am: 13.08.07 - 10:38:23 »
Einen wunder schönen guten Morgen Deutschland.

Ich habe hier mal wieder eine Sache die ich nicht verstehe. Und zwar möchte ich per Knoppfdruck 2 Tabellen in 2 Rich-TextFelder erstellen. Der Code scheint auch richtig zu sein, weil Jede Tabelle für sich funktioniert. Nur wenn ich den Code hintereinander ausführen lassen, kommt er damit anscheinend nicht klar und erstellt immer nur die 2. Warum  :-:
« Letzte Änderung: 13.08.07 - 12:27:36 von bikerboy »
Robert Kreutzer

Anwendungsentwicklung

"Jeder Idiot kann was kompliziertes bauen, es Bedarf eines Genie für etwas einfaches"

Offline eknori

  • @Notes Preisträger
  • Moderator
  • Gold Platin u.s.w. member:)
  • *****
  • Beiträge: 11.728
  • Geschlecht: Männlich
Re: programatischer Tabellenerstellung
« Antwort #1 am: 13.08.07 - 10:41:21 »
Zitat
ch habe hier mal wieder eine Sache die ich nicht verstehe
Weisst du, was ich nicht verstehe?? ... Japanisch!

Zitat
Der Code scheint auch richtig zu sein
Schön zu hören ...

Zitat
Warum
Dazu sagt mir meine Glaskugel momentan nichts ...

Mehr Input, mehr output ...
Egal wie tief man die Messlatte für den menschlichen Verstand auch ansetzt: jeden Tag kommt jemand und marschiert erhobenen Hauptes drunter her!

Offline bikerboy

  • Gold Platin u.s.w. member:)
  • *****
  • Beiträge: 1.155
  • Geschlecht: Männlich
Re: programatischer Tabellenerstellung
« Antwort #2 am: 13.08.07 - 10:57:42 »
Zitat
Weisst du, was ich nicht verstehe?? ... Japanisch!

Bei mir ist es Bân-lâm-gú


Was soll ich denn mehr schreiben ? Ich will hier nicht den ganzen ellenlangen Code schicken. Ich erstelle in halt in einem RichtextFeld eine Tabelle, mit entsprechenden Styles und so weiter und sofort. nachdem ich das getan habe, muss ich das Dokument einmal kurz schliessen und wieder öffnen. Scheint eine Macke von dem RichTextFeld zu sein. Danach erstelle ich halt die 2. Tabelle in einem anderen Feld.

Robert Kreutzer

Anwendungsentwicklung

"Jeder Idiot kann was kompliziertes bauen, es Bedarf eines Genie für etwas einfaches"

Offline DerAndre

  • Gold Platin u.s.w. member:)
  • *****
  • Beiträge: 1.655
  • Geschlecht: Männlich
  • Keep cool!
Re: programatischer Tabellenerstellung
« Antwort #3 am: 13.08.07 - 11:00:48 »
Also am besten suchst Du mal nach RTF und Tabellen.
Dann nimmst Du Dir viel Kaffee und Kuchen und beschäftigst Dich den Rest der Woche damit.
Ohne Code, auch Ellenlang geht hier nüscht.
André

Elterninitiative diabetischer Kinder und Jugendlicher e.V.
-----------------------------------------------------------------------------
Fliegen ist die Kunst auf den Boden zu Fallen, aber daneben.
-----------------------------------------------------------------------------
Etwas mehr Hardware dazu zu kaufen ist viel billiger als
Software besser zu machen. ( Niklaus Wirth )

Offline bikerboy

  • Gold Platin u.s.w. member:)
  • *****
  • Beiträge: 1.155
  • Geschlecht: Männlich
Re: programatischer Tabellenerstellung
« Antwort #4 am: 13.08.07 - 11:03:08 »
Nagut ihr habt es so gewollt  :P :

Code
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
Robert Kreutzer

Anwendungsentwicklung

"Jeder Idiot kann was kompliziertes bauen, es Bedarf eines Genie für etwas einfaches"

Offline m3

  • Freund des Hauses!
  • Gold Platin u.s.w. member:)
  • *****
  • Beiträge: 8.102
  • Geschlecht: Männlich
  • Non ex transverso sed deorsum!
    • leyrers online pamphlet
Re: programatischer Tabellenerstellung
« Antwort #5 am: 13.08.07 - 11:09:17 »
ROTFL!

Hab ich schon erwähnt, dass der Morgen hier in Österrreich auch sehr schön ist?
Darf ich eigentlich antworten, auch wenn ich nicht in DE bin?

Wurscht, ich mach es trotzdem.  ;D


1) "Knopfdruck" - Buttons im Form, Actions des Forms, Toolbar-Buttons oder ganz was anderes?

2) Code "scheint richtig zu sein" gibts nicht. Entweder er ist korrekt, oder nicht.

3) Welcher Code? Formelsprache, LotusScript, Java, C# via COM oder was?

4) Ad RitchTextField: Auf RTF-Inhalte eines neuen Dokumentes kann üblicherweise man erst zugreifen, NACHDEM das Dokument gespeichert wurde.
HTH
m³ aka. Martin -- leyrers online pamphlet | LEYON - All things Lotus (IBM Collaborations Solutions)

All programs evolve until they can send email.
Except Microsoft Exchange.
    - Memorable Quotes from Alt.Sysadmin.Recovery

"Lotus Notes ist wie ein Badezimmer, geht ohne Kacheln, aber nicht so gut." -- Peter Klett

"If there isn't at least a handful of solutions for any given problem, it isn't IBM"™ - @notessensai

Offline DerAndre

  • Gold Platin u.s.w. member:)
  • *****
  • Beiträge: 1.655
  • Geschlecht: Männlich
  • Keep cool!
Re: programatischer Tabellenerstellung
« Antwort #6 am: 13.08.07 - 11:23:53 »
Wenn ich mir den Code so anschaue löscht Du erst das Feld Body und erzeugst Feld neu.
In welchen Feldern soll die Tabelle angelegt werden?
André

Elterninitiative diabetischer Kinder und Jugendlicher e.V.
-----------------------------------------------------------------------------
Fliegen ist die Kunst auf den Boden zu Fallen, aber daneben.
-----------------------------------------------------------------------------
Etwas mehr Hardware dazu zu kaufen ist viel billiger als
Software besser zu machen. ( Niklaus Wirth )

Offline bikerboy

  • Gold Platin u.s.w. member:)
  • *****
  • Beiträge: 1.155
  • Geschlecht: Männlich
Re: programatischer Tabellenerstellung
« Antwort #7 am: 13.08.07 - 11:47:22 »
@m3

Antworten werden unabhängig des Herkunftlandes entgegen genommen. :P

zu 1 . Knopfdruck

zu 2. er funktioniert ja

zu 3. LotusScript (( offensichtlich) wahrscheinlich meine ANtowrt noch nicht gesehen )

zu 4. Der Code ist nicht von mir, habe ihn von nem Kollegen und dann abgewandelt, damit er meine Inhalte richtig darstellt, was ihr hier seht ist der orginale.

@ DerAndre :

Die Tabellen werden im Feld Body abgelegt, dass er die alte Tabelle löscht ist so gewollt, da sich die Postionen aus denen die Tabelle sich erstellt ändern können.
Robert Kreutzer

Anwendungsentwicklung

"Jeder Idiot kann was kompliziertes bauen, es Bedarf eines Genie für etwas einfaches"

Offline DerAndre

  • Gold Platin u.s.w. member:)
  • *****
  • Beiträge: 1.655
  • Geschlecht: Männlich
  • Keep cool!
Re: programatischer Tabellenerstellung
« Antwort #8 am: 13.08.07 - 12:07:36 »
Er funktioniert ja offensichtlich nicht, da er nicht das tut was er soll.
Es sollen 2 Tabellen in 2 Felder gepackt werden.
Warum wird dann immer nur das eine gelöscht?
Welches Originale? Deins oder das vom Kollegen. Wenn es der Code vom Kollegen ist, ist das Käse, Dein Code funzt nicht, nicht der von Deinem Kollegen.
André

Elterninitiative diabetischer Kinder und Jugendlicher e.V.
-----------------------------------------------------------------------------
Fliegen ist die Kunst auf den Boden zu Fallen, aber daneben.
-----------------------------------------------------------------------------
Etwas mehr Hardware dazu zu kaufen ist viel billiger als
Software besser zu machen. ( Niklaus Wirth )

Offline bikerboy

  • Gold Platin u.s.w. member:)
  • *****
  • Beiträge: 1.155
  • Geschlecht: Männlich
Re: programatischer Tabellenerstellung
« Antwort #9 am: 13.08.07 - 12:10:10 »
So einen (Denk)-Fehler habe ich schon gefunden. Und zwar rufe ich die Tabellenerstellung so hinter einander auf :

Code
Sub Click(Source As Button)
	
	Call Body
	
	Call Body2
	
End Sub

benutze aber die selben Variablen nochmal also,

Code
	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
	

und überschreibe diese ja dann. Also bin ich los gegangen und habe den die ganzen Variablen mit einem "m" wie "meins" erweitert. Trotzdem geht der Fehler nicht weg.
Robert Kreutzer

Anwendungsentwicklung

"Jeder Idiot kann was kompliziertes bauen, es Bedarf eines Genie für etwas einfaches"

Offline bikerboy

  • Gold Platin u.s.w. member:)
  • *****
  • Beiträge: 1.155
  • Geschlecht: Männlich
Re: programatischer Tabellenerstellung
« Antwort #10 am: 13.08.07 - 12:11:58 »
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
Robert Kreutzer

Anwendungsentwicklung

"Jeder Idiot kann was kompliziertes bauen, es Bedarf eines Genie für etwas einfaches"

Offline m3

  • Freund des Hauses!
  • Gold Platin u.s.w. member:)
  • *****
  • Beiträge: 8.102
  • Geschlecht: Männlich
  • Non ex transverso sed deorsum!
    • leyrers online pamphlet
Re: programatischer Tabellenerstellung
« Antwort #11 am: 13.08.07 - 12:18:30 »
Zitat
Trotzdem geht der Fehler nicht weg.
Und dieser "Fehler" äußert sich nun wie??????
HTH
m³ aka. Martin -- leyrers online pamphlet | LEYON - All things Lotus (IBM Collaborations Solutions)

All programs evolve until they can send email.
Except Microsoft Exchange.
    - Memorable Quotes from Alt.Sysadmin.Recovery

"Lotus Notes ist wie ein Badezimmer, geht ohne Kacheln, aber nicht so gut." -- Peter Klett

"If there isn't at least a handful of solutions for any given problem, it isn't IBM"™ - @notessensai

Offline bikerboy

  • Gold Platin u.s.w. member:)
  • *****
  • Beiträge: 1.155
  • Geschlecht: Männlich
Re: programatischer Tabellenerstellung
« Antwort #12 am: 13.08.07 - 12:25:46 »
@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"
Robert Kreutzer

Anwendungsentwicklung

"Jeder Idiot kann was kompliziertes bauen, es Bedarf eines Genie für etwas einfaches"

Offline m3

  • Freund des Hauses!
  • Gold Platin u.s.w. member:)
  • *****
  • Beiträge: 8.102
  • Geschlecht: Männlich
  • Non ex transverso sed deorsum!
    • leyrers online pamphlet
Re: programatische Tabellenerstellung
« Antwort #13 am: 13.08.07 - 12:59:26 »
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

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
etwas. "Zawos is des guad" (wozu braucht man das)? Ich würde das als sinnlos erachten.
HTH
m³ aka. Martin -- leyrers online pamphlet | LEYON - All things Lotus (IBM Collaborations Solutions)

All programs evolve until they can send email.
Except Microsoft Exchange.
    - Memorable Quotes from Alt.Sysadmin.Recovery

"Lotus Notes ist wie ein Badezimmer, geht ohne Kacheln, aber nicht so gut." -- Peter Klett

"If there isn't at least a handful of solutions for any given problem, it isn't IBM"™ - @notessensai

Offline bikerboy

  • Gold Platin u.s.w. member:)
  • *****
  • Beiträge: 1.155
  • Geschlecht: Männlich
Re: programatische Tabellenerstellung
« Antwort #14 am: 13.08.07 - 13:12:14 »
@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  ;)
Robert Kreutzer

Anwendungsentwicklung

"Jeder Idiot kann was kompliziertes bauen, es Bedarf eines Genie für etwas einfaches"

Offline m3

  • Freund des Hauses!
  • Gold Platin u.s.w. member:)
  • *****
  • Beiträge: 8.102
  • Geschlecht: Männlich
  • Non ex transverso sed deorsum!
    • leyrers online pamphlet
Re: programatische Tabellenerstellung
« Antwort #15 am: 13.08.07 - 13:18:28 »
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.
HTH
m³ aka. Martin -- leyrers online pamphlet | LEYON - All things Lotus (IBM Collaborations Solutions)

All programs evolve until they can send email.
Except Microsoft Exchange.
    - Memorable Quotes from Alt.Sysadmin.Recovery

"Lotus Notes ist wie ein Badezimmer, geht ohne Kacheln, aber nicht so gut." -- Peter Klett

"If there isn't at least a handful of solutions for any given problem, it isn't IBM"™ - @notessensai

Offline bikerboy

  • Gold Platin u.s.w. member:)
  • *****
  • Beiträge: 1.155
  • Geschlecht: Männlich
Re: programatische Tabellenerstellung
« Antwort #16 am: 13.08.07 - 17:26:48 »
@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.
Robert Kreutzer

Anwendungsentwicklung

"Jeder Idiot kann was kompliziertes bauen, es Bedarf eines Genie für etwas einfaches"

Offline DerAndre

  • Gold Platin u.s.w. member:)
  • *****
  • Beiträge: 1.655
  • Geschlecht: Männlich
  • Keep cool!
Re: programatische Tabellenerstellung
« Antwort #17 am: 14.08.07 - 08:46:27 »
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.
André

Elterninitiative diabetischer Kinder und Jugendlicher e.V.
-----------------------------------------------------------------------------
Fliegen ist die Kunst auf den Boden zu Fallen, aber daneben.
-----------------------------------------------------------------------------
Etwas mehr Hardware dazu zu kaufen ist viel billiger als
Software besser zu machen. ( Niklaus Wirth )

Offline bikerboy

  • Gold Platin u.s.w. member:)
  • *****
  • Beiträge: 1.155
  • Geschlecht: Männlich
Re: programatische Tabellenerstellung
« Antwort #18 am: 14.08.07 - 11:12:54 »
Ich krieg hier die Krise, warum geht das nicht. Ich will doch nur 2 Tabelllen aus einem Knopf erstellen. *heul*
Robert Kreutzer

Anwendungsentwicklung

"Jeder Idiot kann was kompliziertes bauen, es Bedarf eines Genie für etwas einfaches"

Offline bikerboy

  • Gold Platin u.s.w. member:)
  • *****
  • Beiträge: 1.155
  • Geschlecht: Männlich
Re: programatische Tabellenerstellung
« Antwort #19 am: 14.08.07 - 12:30:43 »
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
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
Robert Kreutzer

Anwendungsentwicklung

"Jeder Idiot kann was kompliziertes bauen, es Bedarf eines Genie für etwas einfaches"

 

Impressum Atnotes.de  -  Powered by Syslords Solutions  -  Datenschutz