Lotus via excel

**pastis.vi** · 12/12/2014, 15h50

Bonjour bigboy, bonjour Qwazerty,

J'ai lu cette discussion.
Le sujet date un peu mais le problème persiste...
Qwazerty, j'ai un problème de déclaration de variable visiblement :
"Erreur d'exécution '424': Objet requis"

Voici mon code (qui envoi un mail après avoir fait une mise en forme d'un tableau dans le mail Notes) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
Sub MailRelanceAuto()
 
Dim LeMail As Object
Dim UserName As String
Dim MailDbName As String
Dim BaseMail As Object
Dim Session As Object 'The notes session
Dim Destinataires(0) As String 'si 1 destinataire,
Dim ccDestinataires(2) As String 'si plusieurs personnes en copie jusqu'à 2,
Dim Sujet As String
Dim body As Object
Dim ligdeb As Integer
Dim ligfin As Integer
Dim derligne As Integer
Dim Reference(50) As String
Dim Defaut(50) As String
Dim Action(50) As String
Dim Cible(50) As String
Dim nbcol As Integer
Dim nbrow As Integer
Dim rtpsCols(3) As NotesRichTextStyle
Dim rtpsColsTAGIS(0) As NotesRichTextStyle
Dim sHeaders(3) As String
Dim rtsStyleBarCode As NotesRichTextStyle
Dim rtsTableHeader As NotesRichTextStyle
Dim rtsTableRow As NotesRichTextStyle
Dim rtnav As NotesRichTextNavigator
 
With Sheets("SUIVI CRIMES").Select
    Range("$B$5:$Q$60000").AutoFilter Field:=5
    Range("$B$5:$Q$60000").AutoFilter Field:=14
    Range("$B$5:$Q$60000").AutoFilter Field:=14, Criteria1:="=" 'filtre sur les actions non soldées
 
' 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)
'-----------------------------------------------------------------------------------------------------
    ' Identifie les destinataires et mails à envoyer
    ligdeb = plage.Row
    ligfin = Range("F" & ligdeb).End(xlDown).Row
    Range("F" & ligdeb & ":F" & ligfin).SpecialCells(xlCellTypeVisible).Copy
    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 i = 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" & i).Value 'filtre sur l'action du destinataire
        Set plage = [_filterdatabase].Offset(1).Resize(, 1) 'identifie la plage de lignes visibles après filtre
        Set plage = plage.Resize(plage.Count - 1).SpecialCells(xlCellTypeVisible)
 
        Range("B5").Offset(1, 0).Select
        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
            Loop
            i = i + 1
            If ActiveCell = "" Then
                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
 
        Sujet = "[CRIME] Rappel du suivi d'action(s)"
 
        Destinataires(0) = Range("G" & plage.Row).Value
        ccDestinataires(1) = "toto@tata.com"
        ccDestinataires(2) = "toto@tata.com"
 
        Set Session = CreateObject("Notes.NotesSession")
        UserName = Session.UserName
        MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
        Set BaseMail = Session.GETDATABASE("", MailDbName)
        If Not BaseMail.IsOpen Then BaseMail.OpenMail
 
        ' Création du message
            Set LeMail = BaseMail.CreateDocument
            Call LeMail.AppendItemValue("Form", "Memo")
            Call LeMail.AppendItemValue("sendTo", Destinataires)
            Call LeMail.AppendItemValue("CopyTo", ccDestinataires)
            Call LeMail.AppendItemValue("Subject", Sujet)
            LeMail.SaveMessageOnSend = True
            Set body = LeMail.CreateRichTextItem("Body")
'-----------------------------------------------------------------------------------------------------
        ' Corps du message
            Call body.AppendText("Bonjour,")
            Call body.AddNewLine(2)
            Call body.AppendText("Voici ci-dessous les actions en cours qui vous sont affectées :")
            Call body.AddNewLine(2)
            ' Création du tableau récapitulatif
                nbcol = 4 ' Est le nombre total de colonnes
                nbrow = plage.Count ' Est le nombre total de lignes visibles(donc nb total d'actions)
 
                ' Definition des colonnes et en-têtes
                    sHeaders(0) = "Référence"
                    Set rtpsCols(0) = LeMail.CreateRichTextParagraphStyle
                    rtpsCols(0).Alignment = 0
                    rtpsCols(0).Firstlineleftmargin = 0
                    rtpsCols(0).LeftMargin = 0
                    rtpsCols(0).RightMargin = RULER_ONE_CENTIMETER * 2.7  '3.5
 
                    sHeaders(1) = "Défaut"
                    Set rtpsCols(1) = LeMail.CreateRichTextParagraphStyle
                    rtpsCols(1).Alignment = 0
                    rtpsCols(1).Firstlineleftmargin = 0
                    rtpsCols(1).LeftMargin = 0
                    rtpsCols(1).RightMargin = RULER_ONE_CENTIMETER * 2.1 '4.00
 
                    sHeaders(2) = "Action"
                    Set rtpsCols(2) = LeMail.CreateRichTextParagraphStyle
                    rtpsCols(2).Alignment = 0
                    rtpsCols(2).Firstlineleftmargin = 0
                    rtpsCols(2).LeftMargin = 0
                    rtpsCols(2).RightMargin = RULER_ONE_CENTIMETER * 0.7 '0.9
 
                    sHeaders(3) = "Date Cible"
                    Set rtpsCols(3) = LeMail.CreateRichTextParagraphStyle
                    rtpsCols(3).Alignment = 0
                    rtpsCols(3).Firstlineleftmargin = 0
                    rtpsCols(3).LeftMargin = 0
                    rtpsCols(3).RightMargin = RULER_ONE_CENTIMETER * largTAGIS '5.58
            '-------------------------------------------------------------------------
                ' Définition des élément visuels du tableau
                Set rtsStyleBarCode = LeMail.CreateRichTextStyle
                    rtsStyleBarCode.FontSize = 17
                    rtesStyleBarCode.NotesFont = body.GetNotesFont("3 of 9 Barcode", True)
 
                Set rtsTableHeader = LeMail.CreateRichTextStyle
                    rtsTableHeader.FontSize = 9
                    rtsTableHeader.Bold = True 'en-tête en gras
                    rtsTableHeader.NotesFont = body.GetNotesFont("Sans Serif par défaut", True)
 
                Set rtsTableRow = LeMail.CreateRichTextStyle
                    rtsTableRow.FontSize = 6
                    rtsTableRow.Bold = False
                    rtseTableRow.NotesFont = body.GetNotesFont("Small Fonts", True)
 
                Set rtpsColsTAGIS(0) = LeMail.CreateRichTextParagraphStyle
                    rtpsColsTAGIS(0).Alignment = 0
                    rtpsColsTAGIS(0).Firstlineleftmargin = 0
                    rtpsColsTAGIS(0).LeftMargin = 0
                    rtpsColsTAGIS(0).RightMargin = RULER_ONE_CENTIMETER * 19.41 '3.5
            '-------------------------------------------------------------------------
                Set rtnav = body.CreateNavigator 'création de la variable de navigation dans le tableau
                Call body.AppendTable(nbrow, nbcol, "", 350, rtpsCols) 'créé un tableau de nbrow lignes et nbcol colonnes
 
                ' Renseigne les en-têtes
                Call body.AppendStyle(rtsTableHeader)
                Call rtnav.FindFirstElement(RTELEM_TYPE_TABLECELL)
                For iCol = 1 To nbcol Step 1
                    Call body.BeginInsert(rtnav)
                    Call body.AppendText(sHeaders(iCol - 1))
                    Call body.EndInsert
                    Call rtnav.FindNextElement(RTELEM_TYPE_TABLECELL)
                Next
 
                ' Renseigne les cellules du tableau en fonction des lignes et colonnes
                Call body.AppendStyle(rtsTableRow)
                Call rtnav.FindFirstElement(RTELEM_TYPE_TABLECELL)
                For iRow = 1 To nbrow Step 1
                    For iCol = 1 To nbcol Step 1
                        Call body.BeginInsert(rtnav)
                        If iCol = 1 Then Call body.AppendText(Reference(iRow))
                        If iCol = 2 Then Call body.AppendText(Defaut(iRow))
                        If iCol = 3 Then Call body.AppendText(Action(iRow))
                        If iCol = 4 Then Call body.AppendText(Cible(iRow))
                        Call body.EndIsert
                        Call rtnav.FindNextElement(RTELEM_TYPE_TABLECELL)
                    Next
                Next
                Call doc.Save(True, False)
                Call ws.ViewRefresh
'-----------------------------------------------------------------------------------------------------
        ' Envoi du mail réalisé
            LeMail.SaveMessageOnSend = True
            LeMail.PostedDate = Now()
            LeMail.Send 0
 
        ' On vide la database pour recommencer un mail tout neuf pour le prochain destinataire
            Set BaseMail = Nothing
            Set LeMail = Nothing
            Set Session = Nothing
            Set body = Nothing
            Set rtpsCols(3) = Nothing
            Set rtpsColsTAGIS(0) = Nothing
            Set rtsStyleBarCode = Nothing
            Set rtsTableHeader = Nothing
            Set rtsTableRow = Nothing
            Set rtnav = Nothing
    Next
End With
 
End Sub

Le code plante à la ligne 107 et probablement aux lignes 114, 121, 128, 135, 139, 144 et 149 lorsque j'utilise "LeMail". Aurai-tu une idée de comment déclarer LeMail?

Merci !

**Qwazerty** · 13/12/2014, 15h30

Salut

Juillet 2011... quand même.

La propriété CreateRichTextParagraphStyle semble, d'après ce lien, être liée à la session et non au nouveau mail.

Essais en tenant compte de l'exemple donné sur le lien.

Bonne journée

++
Qwaz

**pastis.vi** · 16/12/2014, 11h26

Salut Qwazerty,

J'ai essayé en utilisant Set rtpsCols(0) = Session.CreateRichTextParagraphStyle et j'ai une erreur d’exécution 13: Incompatibilité de type.
Ensuite je me suis dit que j'avais mal déclaré Session. Du coup j'ai essayé en déclarant Session As New NotesSession et j'obtiens le mm type d'erreur à la ligne 81 : Set Session = CreateObject("Notes.NotesSession").

Voici mon fichier avec la macro pour tester :Test_v2.xlsm

**pastis.vi** · 24/12/2014, 11h08

Coucou !

J'ai enfin réussi à déclarer correctement le schmilblick !

Voilà le code après les dernières modifications :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
Sub MailRelanceAuto()
 
Dim LeMail As Object
Dim UserName As String
Dim MailDbName As String
Dim BaseMail As Object
Dim Session As Object 'The notes session
Dim Destinataires(0) As String 'si 1 destinataire,
Dim ccDestinataires(2) As String 'si plusieurs personnes en copie jusqu'à 2,
Dim Sujet As String
Dim body As Object
Dim ligdeb As Integer
Dim ligfin As Integer
Dim derligne As Integer
Dim Reference(50) As String
Dim Defaut(50) As String
Dim Action(50) As String
Dim Cible(50) As String
Dim nbcol As Integer
Dim nbrow As Integer
Dim rtpsCols(3) As Object
Dim rtpsColsTAGIS(0) As Object
Dim sHeaders(3) As String
Dim rtsStyleBarCode As Object
Dim rtsTableHeader As Object
Dim rtsTableRow As Object
Dim rtnav As NotesRichTextNavigator
 
With Sheets("SUIVI CRIMES").Select
    Range("$B$5:$Q$60000").AutoFilter Field:=5
    Range("$B$5:$Q$60000").AutoFilter Field:=14
    Range("$B$5:$Q$60000").AutoFilter Field:=14, Criteria1:="=" 'filtre sur les actions non soldées
 
' 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)
'-----------------------------------------------------------------------------------------------------
    ' Identifie les destinataires et mails à envoyer
    ligdeb = plage.Row
    ligfin = Range("F" & ligdeb).End(xlDown).Row
    Range("F" & ligdeb & ":F" & ligfin).SpecialCells(xlCellTypeVisible).Copy
    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 i = 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" & i).Value 'filtre sur l'action du destinataire
        Set plage = [_filterdatabase].Offset(1).Resize(, 1) 'identifie la plage de lignes visibles après filtre
        Set plage = plage.Resize(plage.Count - 1).SpecialCells(xlCellTypeVisible)
 
        Range("B5").Offset(1, 0).Select
        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
            Loop
            i = i + 1
            If ActiveCell = "" Then
                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
 
        'For i = 1 To plage.Count 'changer avec le corps du texte du mail
        '    MsgBox Reference(i) & "," & Chr(10) & Defaut(i) & "," & Chr(10) & Action(i) & "," & Chr(10) & Cible(i) 'affiche dans une msgbox les informations pour chaque ligne visible
        'Next
 
        Sujet = "[CRIME] Rappel du suivi d'action(s)"
 
        Destinataires(0) = Range("G" & plage.Row).Value
        ccDestinataires(1) = "toto@tata.com"
        ccDestinataires(2) = "toto@tata.com"
 
        Set Session = CreateObject("Notes.NotesSession")
        UserName = Session.UserName
        MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
        Set BaseMail = Session.GetDatabase("", MailDbName)
        If Not BaseMail.IsOpen Then BaseMail.OPENMAIL
 
        ' Création du message
            Set LeMail = BaseMail.CreateDocument
            Call LeMail.AppendItemValue("Form", "Memo")
            Call LeMail.AppendItemValue("sendTo", Destinataires)
            Call LeMail.AppendItemValue("CopyTo", ccDestinataires)
            Call LeMail.AppendItemValue("Subject", Sujet)
            LeMail.SaveMessageOnSend = True
            Set body = LeMail.CreateRichTextItem("Body")
'-----------------------------------------------------------------------------------------------------
        ' Corps du message
            Call body.AppendText("Bonjour,")
            Call body.AddNewLine(2)
            Call body.AppendText("Voici ci-dessous les actions en cours qui vous sont affectées :")
            Call body.AddNewLine(2)
            ' Création du tableau récapitulatif
                nbcol = 4 ' Est le nombre total de colonnes
                nbrow = plage.Count ' Est le nombre total de lignes visibles(donc nb total d'actions)
 
                ' Definition des colonnes et en-têtes
                    sHeaders(0) = "Référence"
                    Set rtpsCols(0) = Session.CreateRichTextParagraphStyle
                    rtpsCols(0).Alignment = 0
                    rtpsCols(0).Firstlineleftmargin = 0
                    rtpsCols(0).LeftMargin = 0
                    rtpsCols(0).RightMargin = RULER_ONE_CENTIMETER * 2.7  '3.5
 
                    sHeaders(1) = "Défaut"
                    Set rtpsCols(1) = Session.CreateRichTextParagraphStyle
                    rtpsCols(1).Alignment = 0
                    rtpsCols(1).Firstlineleftmargin = 0
                    rtpsCols(1).LeftMargin = 0
                    rtpsCols(1).RightMargin = RULER_ONE_CENTIMETER * 2.1 '4.00
 
                    sHeaders(2) = "Action"
                    Set rtpsCols(2) = Session.CreateRichTextParagraphStyle
                    rtpsCols(2).Alignment = 0
                    rtpsCols(2).Firstlineleftmargin = 0
                    rtpsCols(2).LeftMargin = 0
                    rtpsCols(2).RightMargin = RULER_ONE_CENTIMETER * 0.7 '0.9
 
                    sHeaders(3) = "Date Cible"
                    Set rtpsCols(3) = Session.CreateRichTextParagraphStyle
                    rtpsCols(3).Alignment = 0
                    rtpsCols(3).Firstlineleftmargin = 0
                    rtpsCols(3).LeftMargin = 0
                    rtpsCols(3).RightMargin = RULER_ONE_CENTIMETER * largTAGIS '5.58
            '-------------------------------------------------------------------------
                    'Set docdest = BaseMail.CreateDocument
                    'Set body = LeMail.CreateRichTextItem(docdest, "body")
 
                ' Définition des élément visuels du tableau
                Set rtsStyleBarCode = Session.CreateRichTextStyle
                    rtsStyleBarCode.FontSize = 17
                    rtsStyleBarCode.NotesFont = body.GetNotesFont("Calibri", True)
 
                Set rtsTableHeader = Session.CreateRichTextStyle
                    rtsTableHeader.FontSize = 9
                    rtsTableHeader.Bold = True 'en-tête en gras
                    rtsTableHeader.NotesFont = body.GetNotesFont("Sans Serif par défaut", True)
 
                Set rtsTableRow = Session.CreateRichTextStyle
                    rtsTableRow.FontSize = 6
                    rtsTableRow.Bold = False
                    rtsTableRow.NotesFont = body.GetNotesFont("Arial", True)
 
                Set rtpsColsTAGIS(0) = Session.CreateRichTextParagraphStyle
                    rtpsColsTAGIS(0).Alignment = 0
                    rtpsColsTAGIS(0).Firstlineleftmargin = 0
                    rtpsColsTAGIS(0).LeftMargin = 0
                    rtpsColsTAGIS(0).RightMargin = RULER_ONE_CENTIMETER * 19.41 '3.5
            '-------------------------------------------------------------------------
                Call body.AppendTable(nbrow, nbcol, "", 350, rtpsCols) 'créé un tableau de nbrow lignes et nbcol colonnes
                Set rtnav = body.CreateNavigator 'création de la variable de navigation dans le tableau
 
                ' Renseigne les en-têtes
                Call body.AppendStyle(rtsTableHeader)
                Call rtnav.FindFirstElement(RTELEM_TYPE_TABLECELL)
                For iCol = 1 To nbcol Step 1
                    Call body.BeginInsert(rtnav)
                    Call body.AppendText(sHeaders(iCol - 1))
                    Call body.EndInsert
                    Call rtnav.FindNextElement(RTELEM_TYPE_TABLECELL)
                Next
 
                ' Renseigne les cellules du tableau en fonction des lignes et colonnes
                Call body.AppendStyle(rtsTableRow)
                Call rtnav.FindFirstElement(RTELEM_TYPE_TABLECELL)
                For iRow = 1 To nbrow Step 1
                    For iCol = 1 To nbcol Step 1
                        Call body.BeginInsert(rtnav)
                        If iCol = 1 Then Call body.AppendText(Reference(iRow))
                        If iCol = 2 Then Call body.AppendText(Defaut(iRow))
                        If iCol = 3 Then Call body.AppendText(Action(iRow))
                        If iCol = 4 Then Call body.AppendText(Cible(iRow))
                        Call body.EndIsert
                        Call rtnav.FindNextElement(RTELEM_TYPE_TABLECELL)
                    Next
                Next
                Call doc.Save(True, False)
                Call ws.ViewRefresh
'-----------------------------------------------------------------------------------------------------
        ' Envoi du mail réalisé
            LeMail.SaveMessageOnSend = True
            LeMail.PostedDate = Now()
            LeMail.Send 0
 
        ' On vide la database pour recommencer un mail tout neuf pour le prochain destinataire
            Set BaseMail = Nothing
            Set LeMail = Nothing
            Set Session = Nothing
            Set body = Nothing
            Set rtpsCols(3) = Nothing
            Set rtpsColsTAGIS(0) = Nothing
            Set rtsStyleBarCode = Nothing
            Set rtsTableHeader = Nothing
            Set rtsTableRow = Nothing
            Set rtnav = Nothing
    Next
End With
 
End Sub

J'ai quelques soucis sur les lignes suivantes :
* 144, 149, 154 :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

rtsStyleBarCode.NotesFont = body.GetNotesFont("Calibri", True)

Je ne sais pas comment utiliser GetNotesFont, ça me sort une erreur d'incompatibilité de type.

* ainsi qu'à la ligne 163 :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set rtnav = body.CreateNavigator

A cette ligne j'ai le même problème avec le Navigator, erreur d'incompatibilité de type.

Après de longues recherches je n'ai rien trouvé qui m'aide sur la syntaxe ou l'utilisation des objets...

Merci,
pastis.vi

**Qwazerty** · 06/01/2015, 19h50

Salut

Au vu du code (déclaration de rtNav), tu sembles avoir activé les références Lotus, pourquoi ne pas déclarer correctement les différentes variables objet plutôt que de les déclarer en tant qu'Object. Des fois ça aiderait peut-être, le code semble conforme au exemples fourni par IBM.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Dim richStyle As NotesRichTextStyle

Sinon essaie de regarder dans les références pour repérer les .dll ou les .tab qui contiennent les références, zippe les et poste les ici (pas sur que ce soit suffisant...).
Je n'ai pas Lotus (et pas envie d'installer une version d'essai), donc il est difficile de pouvoir répondre à tes interrogations.

Toujours si les références sont activent, tu peux aussi utiliser l'explorateur dans VBA (raccourci F2), ça peut te permettre de contrôler les types attendus par telle ou telle fonction
++
Qwaz

**pastis.vi** · 13/01/2015, 13h46

Coucou Qwazerty !

Après moultes recherches en attendant ta réponse j'ai trouvé ce qui correspond à mon besoin. En résumé, ma macro fait ceci:
- récupération de valeurs dans une base de donnée filtrée
- sauvegarde de ces valeurs (cellule par cellule) dans des tables vba
- création d'un mail Lotus Notes
- création d'un tableau dans le mail Lotus Notes avec AppendTable
- remplissage du tableau avec CreateNavigator
- envoi du mail à plusieurs destinataires avec une boucle For.

Comme tu l'as dit, je n'utilise que des déclarations classiques de variables. C'est plus simple et ça évite les prises de tête quand il faut se faire tout le code en Alt+F8

Voici mon code pour tous ceux qui en auraient besoin !

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
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
 
'------------------------------------------------------------------------------------------------------------------------------
'RECUPERATION DES DONNEES CLASSEUR:
        Sheets("SUIVI CRIMES").Select
        Range("$B$5:$Q$60000").AutoFilter Field:=5
        Range("$B$5:$Q$60000").AutoFilter Field:=14
        Range("$B$5:$Q$60000").AutoFilter Field:=14, Criteria1:="="                                 'Filtre sur les actions non soldées
 
    ' 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
        ligfin = Range("F" & ligdeb).End(xlDown).Row
        Range("F" & ligdeb & ":F" & ligfin).SpecialCells(xlCellTypeVisible).Copy
        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)
 
            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 = "[CRIME] Rappel du suivi d'action(s)"                           'On défini la variable Sujet
            Destinataire(0) = Range("G" & Plage.Row).Value                          'On défini la variable Destinataire
            ccDestinataires(0) = "toto@tata.com"                                    'On défini la variable ccDestinataire
            ccDestinataires(1) = "toto@tata.com"
 
            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 = 2 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(2)
                '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
        Next
End Sub

Merci pour le coup de pouce en tout cas Qwazerty !
Bonne route !

Lotus via excel

Macros et VBA Excel

Discussions similaires

Partager

Partager