Bonjour j'ai réussi a mettre l’horaire a 9 h en faisant ça mais il me coole des rappel de rendez vous depuis l'année 1899 bizarre comme bug????? pouvez vous m'aider? merci d'avance
Private Sub Worksheet_Change(ByVal Target As Range)
Dim MaDate As Range
Const olAppointmentItem As Long = 1
Dim OLApp As Object
Dim OLNS As Object
Dim OLAppointment As Object
Set MaDate = Range("D1:D100")
If Not Application.Intersect(MaDate, Range(Target.Address)) _
Is Nothing Then
On Error Resume Next
Set OLApp = GetObject(, "Outlook.Application")
If OLApp Is Nothing Then Set OLApp = CreateObject("Outlook.Application")
On Error GoTo 0
If Not OLApp Is Nothing Then
Set OLNS = OLApp.GetNamespace("MAPI")
OLNS.Logon
Set OLAppointment = OLApp.CreateItem(olAppointmentItem)
OLAppointment.Subject = "Relance client"
OLAppointment.Start = Target.Value & " 09:00 "
OLAppointment.Body = Target.Offset(0, -2).Value & " " & Target.Value
OLAppointment.Save
Set OLAppointment = Nothing
Set OLNS = Nothing
Set OLApp = Nothing
End If
End If
c'est encore moi ... es ce du aux cellules vide? peut etre qu'il faut lancer la macro que si la cellule est rempli ?