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
| Sub EnvoiMailTuteur()
Dim MesInvités(40) As String
Dim MonObjet As String
Dim MonCorps As String
MonObjet = Range("MailObjet").Value
MonCorps = "<!DOCTYPE html><body>" & Range("MailPhrase1").Value & "<p>"
MonCorps = MonCorps & Range("MailPhrase2").Value & ActiveSheet.Cells(1, 2) & " "
MonCorps = MonCorps & Range("MailPhrase3").Value & ActiveSheet.Cells(1, 6) & " "
MonCorps = MonCorps & Range("MailPhrase4").Value & ":<p>"
'Début du tableau des absences
MonCorps = MonCorps & "<table border>"
MonCorps = MonCorps & "<tr> <th> Date </th> <th> H.Planifiées </th> <th> H.Présence </th><th> H.Absence </th><th> Retards </th><th>Départs anticipés</th><th>Averti</th><th>Absence justifiée</th></tr>"
For i = 12 To 500
If ActiveSheet.Cells(i, 5).Value > 0 And IsEmpty(ActiveSheet.Cells(i, 7)) And Not IsEmpty(ActiveSheet.Cells(i, 1)) Then
ActiveSheet.Cells(i, 7).Value = Date
MonCorps = MonCorps & "<tr> <td align=""center"">" & Format(ActiveSheet.Cells(i, 2).Value, "dd/mm/yyyy") & "</td>"
MonCorps = MonCorps & "<td align=""center"">" & Format(ActiveSheet.Cells(i, 3).Value, "0.0") & "</td>"
MonCorps = MonCorps & "<td align=""center"">" & Format(ActiveSheet.Cells(i, 4).Value, "0.0") & "</td>"
MonCorps = MonCorps & "<td align=""center"">" & Format(ActiveSheet.Cells(i, 5).Value, "0.0") & "</td>"
MonCorps = MonCorps & "<td align=""center"">" & Format(ActiveSheet.Cells(i, 10).Value) & "</td>"
MonCorps = MonCorps & "<td align=""center"">" & Format(ActiveSheet.Cells(i, 13).Value) & "</td>"
MonCorps = MonCorps & "<td align=""center"">" & Format(ActiveSheet.Cells(i, 14).Value) & "</td>"
MonCorps = MonCorps & "<td align=""center"">" & Format(ActiveSheet.Cells(i, 15).Value) & "</td></tr>"
End If
Next
'Fin du tableau des absences
MonCorps = MonCorps & "</table>"
MonCorps = MonCorps & "Si le justificatif apparaît comme <i>En attente</i> pour une absence consécutive à un <b>arrêt maladie</b>, nous vous remercions de bien vouloir nous faire parvenir une <b>copie du volet employeur de l'avis d'arrêt de travail</b>.<p>"
MonCorps = MonCorps & Range("MailPhrase5").Value & "<p>"
MonCorps = MonCorps & "<FONT color=""blue"">" & Range("MailPhrase6").Value & "</FONT>" & "<br>"
MonCorps = MonCorps & Range("MailPhrase7").Value & "<br>"
MonCorps = MonCorps & Range("MailPhrase8").Value & "<br>"
MonCorps = MonCorps & Range("MailPhrase9").Value & "<br>"
MonCorps = MonCorps & Range("MailPhrase10").Value & "</FONT><br>"
MonCorps = MonCorps & "<FONT color=""steelblue"">" & Range("MailPhrase11").Value & "</FONT>"
MonCorps = MonCorps & "</body><HTML>"
Call MonEnvoiMail(ActiveSheet.Cells(6, 1).Value, ActiveSheet.Cells(2, 2).Value, "", MonObjet, MonCorps, False)
End Sub
Sub MonEnvoiMail(ByVal MesDestinataires As String, ByVal MesDestinatairesCopie As String, _
ByVal MesDestinatairesCopieCachée As Variant, ByVal MonObjet As String, _
ByVal MonCorps As String, ByVal MonChoixPièceAttachée As Boolean)
Dim i As Integer
Dim MonAppMail As Object
Dim MonMail As Object
Set MonAppMail = CreateObject("Outlook.Application")
If Not (MonAppMail Is Nothing) Then
Set MonMail = MonAppMail.CreateItem(0)
With MonMail
.BCC = MesDestinatairesCopieCachée
.CC = MesDestinatairesCopie
.Subject = MonObjet
.BodyFormat = 2
.HTMLBody = MonCorps
.To = MesDestinataires
.Display
End With
Set MonMail = Nothing
Set MonAppMail = Nothing
End If
End Sub |
