[XL-2007] Utiliser CreateNavigator dans création mail Lotus Notes

Bonjour à tous,

J'ai déjà créé un sujet sur la création d'un tableau dans un mail Lotus Notes (avant envoi du mail).
Une particularité du tableau c'est de le remplir avec CreateNavigator.

L'outil CreateNavigator permet de renseigner un tableau dans l'odre suivant:
Pièce jointe 167905
De gauche à droite puis de haut en bas comme sur l'exemple ci-dessus.

Je vous joins mon fichier : Pièce jointe 167906
La macro du fichier permet d'envoyer des mails de relance automatiques. Comme il n'est pas possible de copier/coller un tableau Excel dans Lotus je créé le tableau directement dans le mail. Pour "naviguer" dans le tableau j'utilise une variable appelée rtnav.

Ce fichier fonctionne très bien: chaque action, porteur d'action, etc est bien inscrit dans les cases du tableau.

Sauf que lorsque je souhaite rajouter une colonne ou faire des modifications dans mon fichier Excel, j'ai beau adapter le code, j'obtiens : chaque action, porteur d'action, etc se trouve inscrit en dehors du tableau (dessous en l’occurrence).

Je ne sais pas si j'exprime correctement le problème. Mais globalement c'est mon CreateNavigator qui pose problème. Comme je suis avide d'information je prends tout ce qui est à prendre comme conseil !

Merci beaucoup pour le coup de pouce !

ps, je balance le code pour ceux qui ne souhaiteraient pas télécharger le fichier :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
Sub envoi_mail_Suivi()
 
    'Déclaration
    Dim Maildb As Object                'La database des mails
    Dim UserName As String              'Le nom d'utilisateur
    Dim MailDbName As String            'Le nom de la database des mails
    Dim MailDoc As Object               'Le mail
    Dim Session As Object               'La session Notes
    Dim Signature As String             'La signature
    Dim Sujet As String                 'Le sujet du mail
    Dim sHeaders(4) As String           'Les noms d'en-têtes du tableau
    Dim Reference(50) As String         'Les valeurs de la colonne 1 du tableau
    Dim Defaut(50) As String            'Les valeurs de la colonne 2 du tableau
    Dim Action(50) As String            'Les valeurs de la colonne 3 du tableau
    Dim Cible(50) As String             'Les valeurs de la colonne 4 du tableau
    Dim rtsTableHeader As Object        'Mise en forme du texte en-têtes
    Dim rtsTableRow As Object           'Mise en forme du texte cellules tableau
    Dim Destinataire(0) As Variant      'Liste destinataire
    Dim ccDestinataires(2) As Variant   'Liste destinataires en copie
    Dim derligne As Integer             'Dernière ligne de la liste des destinataires
    Dim ligdeb As Integer               'Première ligne, après filtre, de la liste des actions
    Dim ligfin As Integer               'Dernière ligne, après filtre, de la liste des actions
    Dim nbrow As Integer                'Nombre de lignes du tableau
    Dim nbcol As Integer                'Nombre de colonnes du tableau
    Dim rtnav As Object                 'Variable de recherche dans le tableau
    Dim jour As Long                    'Date du jour
 
'------------------------------------------------------------------------------------------------------------------------------
'RECUPERATION DES DONNEES CLASSEUR:
        Sheets("SUIVI CRIMES").Select
        Range("$B$5:$Q$60000").AutoFilter Field:=5
        Range("$B$5:$Q$60000").AutoFilter Field:=7
        Range("$B$5:$Q$60000").AutoFilter Field:=14
        Range("$B$5:$Q$60000").AutoFilter Field:=14, Criteria1:="="                                 'Filtre sur les actions non soldées
        jour = Date
        Range("$B$5:$Q$60000").AutoFilter Field:=7, Criteria1:="<" & jour                           'Filtre sur les actions ayant dépassé la date cible
 
    ' Défini les numéro de lignes (début et fin) lors du filtrage sur la colonne G)
        Set Plage = [_filterdatabase].Offset(1).Resize(, 1)
        Set Plage = Plage.Resize(Plage.Count - 1).SpecialCells(xlCellTypeVisible)                   'Détermine la plage de cellules visibles
 
    ' Identifie les destinataires et mails à envoyer
        ligdeb = Plage.Row                                                                          'Première ligne de la plage filtrée
        ligfin = Range("F60000").End(xlUp).Row                                                      'Dernière ligne de la plage filtrée
        Range("F" & ligdeb & ":F" & ligfin).SpecialCells(xlCellTypeVisible).Copy                    'On copie la plage de données visible
        Sheets("Calculs").Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Sheets("Calculs").Range("$A$1:$A$" & ligfin - 5).RemoveDuplicates columns:=1, Header:=xlNo
        If Sheets("Calculs").Range("A2").Value = "" Then                                            'Détermine la dernière ligne de la liste des destinataires
            derligne = 1
        Else
            derligne = Sheets("Calculs").Range("A1").End(xlDown).Row
        End If
 
        For d = 1 To derligne                                                                       'Créé le mail et l'envoi pour chaque déstinataire : 1 boucle = 1 destinataire
            Range("$B$5:$Q$60000").AutoFilter Field:=5, Criteria1:=Sheets("Calculs").Range("A" & d).Value 'Filtre sur l'action du destinataire
            Set Plage = [_filterdatabase].Offset(1).Resize(, 1)
            Set Plage = Plage.Resize(Plage.Count - 1).SpecialCells(xlCellTypeVisible)
            If Range("G" & Plage.Row).Value = "" Then GoTo IterationSuivante                        'Si le mail n'est pas renseigné, le mail n'est pas créé et on passe au destinataire suivant
            Range("B5").Offset(1, 0).Select                          'Donne la première ligne de notre tableur après le filtre
            i = 0
            j = 0
 
            Do While j < 2                                           'Va jusqu'à 2 lignes vides après la dernière ligne visible filtrée
                Do While ActiveCell.EntireRow.Hidden = True          'Teste si la ligne est visible
                    ActiveCell.Offset(1, 0).Select                   'On se déplace dans notre tableur : +1 ligne
                Loop
                i = i + 1
                If ActiveCell = "" Then                              'Si la cellule ext vide alors...
                    j = j + 1
                Else
                    Reference(i) = ActiveCell.Value                  'Enregistre les valeurs, pour chaque ligne visible, dans des tables définies
                    Defaut(i) = ActiveCell.Offset(0, 1).Value
                    Action(i) = ActiveCell.Offset(0, 3).Value
                    Cible(i) = ActiveCell.Offset(0, 6).Value
                End If
            ActiveCell.Offset(1, 0).Select
            Loop
 
'------------------------------------------------------------------------------------------------------------------------------
'CREATION DU MAIL:
            Sujet = "Suivi du portefeuille des actions CRIME"                       'On défini la variable Sujet
            Destinataire(0) = Range("G" & Plage.Row).Value                          'On défini la variable Destinataire
            ccDestinataires(0) = "tutu@gmail.com"                                   'On défini la variable ccDestinataire
 
            Set Session = CreateObject("Notes.NotesSession")                        'Crée une session notes
            UserName = Session.UserName                                             'Récupère le nom d'utilisateur et crée le nom de la base des mails
            MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
            Set Maildb = Session.GetDatabase("", MailDbName)                        'Ouvre la base des mails
            If Not Maildb.IsOpen Then Maildb.OPENMAIL                               'Test si la base mail est bien ouverte
            Set MailDoc = Maildb.CreateDocument                                     'Paramètre le mail à envoyer
            'Call MailDoc.AppendItemValue("Form", "Memo")
            'Call MailDoc.AppendItemValue("sendTo", Destinataire)                    'Paramètre les destinataires des mails (par la table Destinataires)
            'Call MailDoc.AppendItemValue("CopyTo", ccDestinataires)                 'Paramètre les destinataires en copie des mails (par la table ccDestinataires)
            'Call MailDoc.AppendItemValue("Subject", Sujet)
 
            nbcol = 4                       'Paramètre le nombre de colonnes du tableau
            nbrow = Plage.Count + 1         'Paramètre le nombre de lignes du tableau (basé sur le nombre d'actions affectées au destinataire)
 
            sHeaders(0) = "Référence"       'Première en-tête du tableau
            sHeaders(1) = "Défaut"          'Seconde en-tête du tableau
            sHeaders(2) = "Action"          'Troisième en-tête du tableau
            sHeaders(3) = "Date Cible"      'Quatrième en-tête du tableau
 
            'Signature = Maildb.GetProfileDocument("CalendarProfile").GetItemValue("Signature")(0)                   'Récupération de la signature Notes
            'MailDoc.AppendItemValue ("iTitle"), Maildb.GetProfileDocument("CalendarProfile").GetItemValue("iTitle") 'Récupération du titre
            'MailDoc.Logo = "StdNotesLtr99"
 
 
'CORPS DU MESSAGE:
            Set rtitem = MailDoc.CreateRichTextItem("Body")                 'Paramètre le corps du mail
 
            Call rtitem.AppendText("Bonjour,")                              'Marque "Bonjour"
            Call rtitem.AddNewLine(2)                                       'Ajoute un saut de ligne
            If nbrow = 1 Then Call rtitem.AppendText("Voici, ci-dessous, l'action en cours qui vous est affectée :")       'Si une seule action alors ce texte
            If nbrow >= 2 Then Call rtitem.AppendText("Voici, ci-dessous, les actions en cours qui vous sont affectées :")  'Si plusieurs actions alors ce texte
            Call rtitem.AddNewLine(2)
 
               Set rtsTableHeader = Session.CreateRichTextStyle             'Paramètre la police des en-têtes
                     rtsTableHeader.Bold = True                             'Texte en gras
                     rtsTableHeader.FontSize = 12                           'Texte en taille 12
 
                Set rtsTableRow = Session.CreateRichTextStyle               'Paramètre la police des cellules
                    rtsTableRow.Bold = False                                'Texte pas en gras
                    rtsTableRow.FontSize = 10                               'Texte en taille 10
 
            Call rtitem.AppendTable(nbrow, nbcol)                           'Création du tableau avec nbrow lignes et nbcol colonnes
            Set rtnav = rtitem.CreateNavigator                              'Paramètre la variable de navigation dans le tableau
            'La navigation dans le tableau fonctionne comme ceci : balayage des cellules de gauche à droite en priorité, puis de haut en bas.
 
            Call rtitem.AppendStyle(rtsTableHeader)                         'Renseigne les en-têtes
            Call rtnav.FindFirstElement(RTELEM_TYPE_TABLECELL)              'Trouve la première cellule de mon tableau
            For iCol = 1 To nbcol Step 1
                Call rtitem.BeginInsert(rtnav)                              'Insère un élément dans le tableau via rtnav
                Call rtitem.AppendText(sHeaders(iCol - 1))
                Call rtitem.EndInsert                                       'Arrête l'insertion de texte
                Call rtnav.FindNextElement(RTELEM_TYPE_TABLECELL)           'Va à la prochaine cellule de mon tableau
            Next
 
            Call rtitem.AppendStyle(rtsTableRow)                            'Renseigne les cellules du tableau
            For iRow = 1 To nbrow Step 1
                For iCol = 1 To nbcol Step 1
                    Call rtitem.BeginInsert(rtnav)
                    If iCol = 1 Then Call rtitem.AppendText(Reference(iRow))
                    If iCol = 2 Then Call rtitem.AppendText(Defaut(iRow))
                    If iCol = 3 Then Call rtitem.AppendText(Action(iRow))
                    If iCol = 4 Then Call rtitem.AppendText(Cible(iRow))
                    Call rtitem.EndInsert
                    Call rtnav.FindNextElement(RTELEM_TYPE_TABLECELL)
                Next
            Next
 
            'signature
                Call rtitem.AddNewLine(1)
                Call rtitem.AppendText("Cordialement,")
                Call rtitem.AddNewLine(1)
                Call rtitem.AppendText("Prenom Nom")
                'Call rtitem.appendtext(Signature)
                'Call rtitem.AddNewLine(2)
 
            MailDoc.SaveMessageOnSend = True                                 'Sauvegarde le mail envoyé
            MailDoc.PostedDate = Now()
            Call MailDoc.Save(True, False)
            MailDoc.Send 0                                                   'Envoie le mail
 
            Erase Reference                                                  'Initialise les variable tableau pour les mails des prochains contacts
            Erase Defaut
            Erase Action
            Erase Cible
IterationSuivante:
        Next
End Sub