DominoArea.org [Archive]

Bonjour à tous !

Ayant du faire plusieurs bases générant des rapport sous le forme de tableau, je me suis dis qu'une petite classe pourrait être sympa, la partager avec vous serait encore mieux

Le tableau généré sera de type ALTERNATE_ROW et aura une ligne en gras pour le header
La classe s'utilise comme ceci :
[syntax="LotusScript"]'La déclaration
Dim tabToCreate As richTextTab
Set tabToCreate = New richTextTab

'Il est possible, mais pas obligatoire, de configurer les couleurs des lignes en mode RGB. Cela permet aussi de configurer la même couleur pour toutes les lignes et ainsi obtenir un tableau "Solid"
Call tabToCreate.setOptionRGB([Couleur ligne paire R] As Integer, [Couleur ligne paire G] As Integer, [Couleur ligne paire B] As Integer, [Couleur ligne impaire R] As Integer, [Couleur ligne impaire G] As Integer, [Couleur ligne impaire B] As Integer)

'On initialise le tableau
Call tabToCreate.initTab([document où se trouve le champ RichText] As NotesDocument, [nom du champ RichText] As String, [Nombre de colonne] As Integer, [Arraycontenant les tailles des colonnes du tableau] As Variant, [Array contenant les titres des colonnes du tableau] As Variant])

'Puis, pour chaque nouvelle ligne
Call tabToCreate.addLine([Array contenant les datas à écrire par colonne] As Variant, [Code couleur Notes] As Integer, [Gras ou pas] as Boolean)[/syntax]

En esperant que cela soit assez claire

Et voici le code de la classe :
[syntax="LotusScript"]
Public Class richTextTab
Private session As NotesSession
Private allTable As NotesRichTextTable
Private rtnav As NotesRichTextNavigator
Private rtitem As NotesRichTextItem

Private firstColor(3) As Integer
Private secondColor(3) As Integer
Private setOptionCall As Boolean
Private nbCol As Integer

Public Sub setOptionRGB(firstColorPassR As Integer, firstColorPassG As Integer, firstColorPassB As Integer, secondColorPassR As Integer, secondColorPassG As Integer, secondColorPassB As Integer)
firstColor(1) = firstColorPassR
firstColor(2) = firstColorPassG
firstColor(3) =firstColorPassB

secondColor(1) = secondColorPassR
secondColor(2) = secondColorPassG
secondColor(3) = secondColorPassB
setOptionCall = True
End Sub

Public Sub initTab(docToAppend As NotesDocument, richTextItem As String, nbColPass As Integer, arrayTailleCol As Variant, arrayTitleCol As Variant)
Dim richStyleTableHeader As NotesRichTextStyle
Dim richStyleTableBody As NotesRichTextStyle
Dim colorObject As NotesColorObject
Dim colorObjectAlternate As NotesColorObject
Dim rtpsStyleArray() As NotesRichTextParagraphStyle
Dim rtpStyle As NotesRichTextParagraphStyle

If(setOptionCall = False) Then
Call setOptionRGB(225, 225, 225, 192, 192, 192)
End If

nbCol = nbColPass
Redim rtpsStyleArray(nbCol - 1)

Set session = New NotesSession
Set richStyleTableHeader = CreateRichTextStyleHeader()
Set richStyleTableBody = CreateRichTextStyleBody()
Set rtitem = New NotesRichTextItem(docToAppend, richTextItem)
Call rtItem.AppendStyle(richStyleTableHeader)
Set colorObject = session.CreateColorObject
Call colorObject.SetRGB(firstColor(1), firstColor(2), firstColor(3))
Set colorObjectAlternate = session.CreateColorObject
Call colorObjectAlternate.SetRGB(secondColor(1), secondColor(2), secondColor(3))
Call CreateRichTextParagraphStyle(rtpsStyleArray, arrayTailleCol)
Call rtItem.AppendTable(1, nbCol, , RULER_ONE_INCH, rtpsStyleArray)
Set rtnav = rtitem.CreateNavigator
Set allTable = rtnav.GetFirstElement(RTELEM_TYPE_TABLE)
Call AppendTableHeader(rtnav, rtitem, arrayTitleCol)
allTable.Style = TABLESTYLE_ALTERNATINGROWS
Call allTable.SetAlternateColor(colorObjectAlternate)
Call allTable.SetColor(colorObject)
Call rtItem.AppendStyle(richStyleTableBody)
End Sub

Public Sub addLine(data As Variant, color As Integer, bold As Boolean)
Dim richStyle As NotesRichTextStyle
Dim session As New NotesSession

Set richStyle = session.CreateRichTextStyle

richStyle.Bold = bold
richStyle.NotesColor = color
Call rtitem.AppendStyle(richStyle)



allTable.AddRow(1)
Forall dataSel In data
rtnav.FindNExtElement(RTELEM_TYPE_TABLECELL)
Call rtitem.BeginInsert(rtnav)
Call rtitem.AppendText(dataSel)
Call rtitem.EndInsert
End Forall
End Sub

Private Function CreateRichTextStyleHeader As NotesRichTextStyle
Dim tableHeaderStyle As NotesRichTextStyle
Set tableHeaderStyle = session.CreateRichTextStyle
tableHeaderStyle.NotesFont = FONT_HELV
tableHeaderStyle.FontSize = 8
tableHeaderStyle.Bold = True
Set CreateRichTextStyleHeader = tableHeaderStyle
End Function

Private Function CreateRichTextStyleBody As NotesRichTextStyle
Dim tableHeaderStyle As NotesRichTextStyle
Set tableHeaderStyle = session.CreateRichTextStyle
tableHeaderStyle.NotesFont = FONT_HELV
tableHeaderStyle.FontSize = 8
tableHeaderStyle.Bold = False
Set CreateRichTextStyleBody = tableHeaderStyle
End Function

Private Function CreateRichTextParagraphStyle(rtpsStyleArray() As NotesRichTextParagraphStyle, arrayMarginCol As Variant)
Dim xBoucleCol As Integer

For xBoucleCol = 0 To nbCol - 1
Set rtpsStyleArray(xBoucleCol) = session.CreateRichTextParagraphStyle()
With rtpsStyleArray(xBoucleCol)
Call .ClearAllTabs()
.LeftMargin = RULER_ONE_INCH * 0.0625
.FirstLineLeftMargin = RULER_ONE_INCH * 0.0625
.RightMargin = RULER_ONE_INCH * arrayMarginCol(xBoucleCol)
.Alignment = ALIGN_LEFT
End With
Next
End Function

Private Function AppendTableHeader(rtnav As NotesRichTextNavigator, rtitem As NotesRichTextItem, arrayTextCol As Variant)
Dim xBoucleCol As Integer

rtnav.FindFirstElement(RTELEM_TYPE_TABLECELL)
For xBoucleCol = 0 To nbCol - 1
Call rtitem.BeginInsert(rtnav)
Call rtitem.AppendText(arrayTextCol(xBoucleCol))
Call rtitem.EndInsert
Call rtnav.FindNextElement(RTELEM_TYPE_TABLECELL)
Next
End Function
End Class
[/syntax]

J'ai pris le temps de faire un vrai exemple.
Le code ci-dessous permet de récupérer les documents de la vue "vueDoc", définir si le niveau d'importance est à "High", et, en fonction, écrire une ligne dans le tableau en rouge gras ou en noir normal.

[syntax="LotusScript"]#### (OPTIONS) ####
Use "bibParserCSV"[/syntax]

[syntax="LotusScript"]Sub Initialize
Dim session As New NotesSession
Dim dbInProgress As NotesDatabase
Dim vToSearch As NotesView
Dim docToWork As NotesDocument
Dim docToCreate As NotesDocument
Dim tabToCreate As richTextTab
Dim arrayTaille As Variant
Dim arrayTitle As Variant
Dim arrayInfoToPrint As Variant

Set dbInProgress = session.CurrentDatabase
Set vToSearch = dbInProgress.GetView("vueDoc")
Set docToCreate = dbInProgress.CreateDocument
Set tabToCreate = New richTextTab

'Définition de la taille des colonnes
arrayTaille(0) = 0.5
arrayTaille(1) = 2

'Définition du titre des colonnes
arrayTitle(0) = "N°"
arrayTitle(1) = "Titre"

'On définit la couleur du tableau (ALTERNATING ROWS)
Call tabToCreate.setOptionRGB(225, 225, 225, 192, 192, 192)

'On initialise le tableau
Call tabToCreate.initTab(docToCreate, "iRichText", 2, arrayTaille, arrayTitle)

Set docToWork = vToSearch.GetFirstDocument
While Not(docToWork Is Nothing)
arrayInfoToPrint(0) = docToWork.numDoc(0)
arrayInfoToPrint(1) = docToWork.titreDoc(0)
If(docToWork.important(0) = "High") Then
'On ajoute une ligne pour chaque document trouvé correspondant au niveau "High"
Call tabToCreate.addLine(arrayInfoToPrint, COLOR_RED, True)
Else
'On ajoute une ligne pour chaque document trouvé ne correspondant pas au niveau "High"
Call tabToCreate.addLine(arrayInfoToPrint, COLOR_BLACK, False)
End If
Set docToWork = vToSearch.GetNextDocument(docToWork)
Wend
Call docToCreate.Save(False, False)
End Sub[/syntax]

Il reste encore des fonctions à implémenter, je m'en occuperai en temps voulu, où peut-être que l'un d'entre vous viendra compléter ce code, enfin si quelqu'un le trouve intéressant
N'hésitez pas à me dire si il y a des choses qui ne vont pas

Salut,

T'aurais un exemple d'utilisation ?!?

Je l'utilise mais c'est dans des programmes plutôt fournis en code et dans différentes fonction, c'est un peu bordélique... Mais l'exemple d'utilisation pose un problème? Dis moi ce qu'il ne vas pas voir si je peux t'aider

Voir le premier post pour les mises à jour et l'exemple

Merci bien !

Bonjour,

J'ai un bug sur la ligne arrayTaille(0)=0.5. Pouvez-vous m'éclairer ?

Cordialement,

ngi

dans l'exemple ci-dessus tu remplaces:

Code : Tout sélectionner

Dim arrayTaille As Variant
Dim arrayTitle As Variant
Dim arrayInfoToPrint As Variant

par :

Code : Tout sélectionner

Dim arrayTaille(1) As Variant
Dim arrayTitle(1) As Variant
Dim arrayInfoToPrint(1) As Variant

et si tu veux plus de colonnes tu changes l'indice.
si tu veux 4 colonnes tu mets 3

N'oublies pas de changer l'indice dans cette ligne :

Code : Tout sélectionner

Call tabToCreate.initTab(docSynthese, "RTActions", 3, arrayTaille, arrayTitle)

Vraiment très bien cette classe.
Merci StasS