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
|
Sub envoi_mail_Suivi()
'Déclaration
Dim Maildb As Object 'La base des mails
Dim UserName As String 'Le nom d'utilisateur
Dim MailDbName As String 'Le nom de la base des mails
Dim MailDoc As Object 'Le mail
Dim UIdoc As Object 'Le mail
Dim AttachME As Object 'L'objet pièce jointe en RTF
Dim Session As Object 'La session Notes
Dim Signature As String 'signature
Dim EmbedObj As Object 'L'objet incorporé
Dim MyStyle As Object 'Mise en forme du corp de texte
Dim recip(25) As Variant 'liste destinataire
Dim Recipient(25) As Variant 'liste destinataire
Dim Plage As Object 'Tableau suivi
Dim rows As Integer
Dim columns As Integer
Dim tabs() As String
Dim rtnav As Object
'Crée une session notes
Set Session = CreateObject("Notes.NotesSession")
'Récupère le nom d'utilisateur et crée le nom de la base des mails
UserName = Session.UserName
MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
'Ouvre la base des mails
Set Maildb = Session.GETDATABASE("", MailDbName)
If Maildb.IsOpen = True Then
WasOpen = 1 'Déja ouvert
Else
WasOpen = 0
Maildb.OPENMAIL 'Ouverture de la base mail
End If
'Paramètre le mail à envoyer
Set MailDoc = Maildb.CREATEDOCUMENT
MailDoc.Form = "Memo"
'MailDoc.SIGNONSEND = True
w_la_date = Format(Date, "dd/mm/yyyy")
'Mise à jour du numéro
'If Sheets("param").Cells(2, 2).Value <> w_la_date Then
' Sheets("param").Cells(2, 2).Value = Format(Date, "dd/mm/yyyy")
' Sheets("param").Cells(2, 3).Value = 1
'Else
'Mise à jour du numéro
' w_numero = Sheets("param").Cells(2, 3).Value
' Sheets("param").Cells(2, 3).Value = w_numero + 1
'End If
w_la_date2 = Format(Sheets("param").Cells(2, 2).Value, "dd-mm-yyyy")
MailDoc.Subject = Sheets("param").Cells(2, 1).Value & " " & Sheets("param").Cells(2, 2).Value & "N°" & Sheets("param").Cells(2, 3).Value
'Destinataire
j = 0
For i = 2 To 20
If Sheets("param").Cells(i, 6).Value <> "" Then
Recipient(j) = Sheets("Param").Cells(i, 6).Value
j = j + 1
End If
Next i
'Destinataires Copie
cRecipient = ""
j = 0
For i = 2 To 20
If Sheets("Param").Cells(i, 7).Value <> "" Then
recip(j) = Sheets("Param").Cells(i, 7).Value
j = j + 1
End If
Next i
MailDoc.sendto = Recipient
MailDoc.copyto = recip
'récupération de la signature Notes
Signature = Maildb.GetProfileDocument("CalendarProfile").GetItemValue("Signature")(0)
'récupération du titre
MailDoc.AppendItemValue ("iTitle"), Maildb.GetProfileDocument("CalendarProfile").GetItemValue("iTitle")
MailDoc.Logo = "StdNotesLtr99"
'texte mail
Set rtitem = MailDoc.CREATERICHTEXTITEM("Body")
Set MyStyle = Session.CreateRichTextStyle
With rtitem
MyStyle.Bold = True
MyStyle.FontSize = 12
Call rtitem.AppendStyle(MyStyle)
.Addtab (6)
.AppendText (Sheets("param").Cells(2, 4).Value & " " & w_la_date2 & " N°" & Sheets("param").Cells(2, 3).Value)
.ADDNEWLINE (1)
MyStyle.Bold = False
MyStyle.FontSize = 10
Call rtitem.AppendStyle(MyStyle)
End With
'Creation tableau onglet
rows = 2
columns = 1
ReDim tabs(1 To rows)
tabs(1) = "Dashboard"
tabs(2) = "Details"
Call rtitem.Appendtable(rows, columns, tabs)
'Remarque si besoin
If Sheets("param").Cells(2, 8).Value <> "" Then
Call rtitem.ADDNEWLINE(2)
Call rtitem.AppendText("Remarque : " & Sheets("param").Range("H2").Value)
End If
'signature
Call rtitem.ADDNEWLINE(2)
Call rtitem.AppendText(Signature)
Call rtitem.ADDNEWLINE(2)
'sauvegarde du mail dans ENVOYE
MailDoc.SAVEMESSAGEONSEND = SaveIt
'Envoie le mail (commande SEND, ou le génère seulement automatiquement)
MailDoc.PostedDate = Now()
'MailDoc.SEND 0, Recipient
'MailDoc.SEND 0, cRecipient
Call MailDoc.Save(True, False)
Set Workspace = CreateObject("Notes.NotesUIWorkspace")
Call Workspace.EDITDOCUMENT(True, MailDoc).GoToField("body")
Set UIdoc = Workspace.CurrentDocument
UIdoc.EditMode = True
'Copie Tableau1
For i = 1 To 20
If Sheets("suivi").Cells(i, 1).Value = "header1" Then
Tab1 = i
Else
If Sheets("suivi").Cells(i, 1).Value = "Fin1" Then
Tab2 = i - 1
End If
End If
Next i
RowTab1 = "B" & Tab1
ColTab1 = "I" & Tab2
Sheets("Suivi").Range(RowTab1 & ":" & ColTab1).CopyPicture Format:=xlBitmap
Call UIdoc.Paste
'Call UIdoc.InsertText(vbCrLf)
'Copie Tableau2
For i = 1 To 50
If Sheets("suivi").Cells(i, 1).Value = "header2" Then
Tab3 = i
Else
If Sheets("suivi").Cells(i, 1).Value = "Fin2" Then
Tab4 = i - 1
End If
End If
Next i
RowTab2 = "D" & Tab3
ColTab2 = "I" & Tab4
'--> Je souhaiterai pouvoir me positionner dans mon tableau à onglet et coller ma sélection
Sheets("Suivi").Range(RowTab2 & ":" & ColTab2).CopyPicture Format:=xlBitmap
Call UIdoc.Paste
'Call UIdoc.InsertText(vbCrLf)
End Sub |
