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
| Sub AjoutRV()
Dim DLig As Long, Lig As Long
Dim OutObj As Outlook.Application
Dim OutAppt As Outlook.AppointmentItem
Dim DateRdv As Date, FlgRdv As Boolean
' j'aimerais que ce rappel soit envoyé à des adresses bien précises sur mon tableau intitulé EMAIL
Set OutObj = CreateObject("outlook.application")
With Sheets("base")
DLig = .Range("B" & Rows.Count).End(xlUp).Row
For Lig = 5 To DLig
If .Range("H" & Lig) <> "" Then
If .Range("H" & Lig).Comment.Text <> .Range("D" & Lig).Value Then
FlgRdv = True
Else
FlgRdv = False
End If
Else
FlgRdv = True
End If
If FlgRdv Then
DateRdv = Range("E" & Lig)
Set OutAppt = OutObj.CreateItem(olAppointmentItem)
With OutAppt
.Subject = "DATE LIMITE APPROCHANTE TAMPON : " & Sheets("base").Range("B" & Lig) & " " & Sheets("base").Range("C" & Lig) & " se situant " & Sheets("base").Range("D" & Lig)
.Start = DateRdv & " 08:00"
.Duration = 60
.ReminderSet = True
.Save
End With
On Error Resume Next
.Range("H" & Lig).Comment.Delete
' ici j'aimerais les jours restants datedif en fonction de ma date de rappel
.Range("H" & Lig).AddComment Text:="xxx"
.Range("H" & Lig) = "Oui"
On Error GoTo 0
End If
Next Lig
End With
Set OutAppt = Nothing
End Sub |
Partager