Plage de dates pour rdv - VB / Excel / Outlook
Résolu
Zhiteapple
-
Zhiteapple -
Zhiteapple -
Bonjour,
Je suis très novice en matière de VB, veuillez m'excuser.
Je cherche à créer des rdv Outlook à partir d'une liste de dates au format JJ.MM.AAAA, en l'occurrence des jours de congé.
Ces dates sont individuellement entrées dans une plage de cellules A4:A19
J'utilise le code suivant, qui fonctionne très bien (il me crée bien un rendez-vous le 2 juin 2016), mais il faut entrer la date manuellement, auriez-vous peut-être une astuce pour que la macro prenne automatiquement chaque date individuelle pour assigner un rendez-vous à chacune ?
Merci d'avance pour votre aide !
Guy
Je suis très novice en matière de VB, veuillez m'excuser.
Je cherche à créer des rdv Outlook à partir d'une liste de dates au format JJ.MM.AAAA, en l'occurrence des jours de congé.
Ces dates sont individuellement entrées dans une plage de cellules A4:A19
Sub NouveauRDV_Calendrier()
Dim OkApp As New Outlook.Application
Dim Rdv As Outlook.AppointmentItem
Set Rdv = OkApp.CreateItem(olAppointmentItem)
With Rdv
.MeetingStatus = Meeting
.Subject = "Vacances"
.Start = "02.06.2016"
.AllDayEvent = True
.Categories = "Congé"
.ReminderSet = False
.Save
End With
Set OkApp = Nothing
End Sub
J'utilise le code suivant, qui fonctionne très bien (il me crée bien un rendez-vous le 2 juin 2016), mais il faut entrer la date manuellement, auriez-vous peut-être une astuce pour que la macro prenne automatiquement chaque date individuelle pour assigner un rendez-vous à chacune ?
Merci d'avance pour votre aide !
Guy
1 réponse
-
Sub NouveauRDV_Calendrier()
Dim OkApp As New Outlook.Application
Dim Rdv As Outlook.AppointmentItem
Dim dates, date_i As Range
Set dates = Range("A4:A19")
For Each date_i In dates.Rows
If IsDate(date_i.Value) Then
Set Rdv = OkApp.CreateItem(olAppointmentItem)
With Rdv
.MeetingStatus = Meeting
.Subject = "Vacances"
.Start = date_i.Value
.AllDayEvent = True
.Categories = "Congé"
.ReminderSet = False
.Save
End With
End If
Next
Set OkApp = Nothing
End Sub
--
-
C'est magnifique, tout fonctionne.
Est-ce que j'ose vous demander si vous connaissez un moyen simple de paramétrer la macro pour ajouter uniquement les nouvelles dates dans Outlook (si la plage augmente) à chaque exécution ?
Si non, ce n'est pas grave, je peux aussi supprimer les doublons de l'exécution précédente dans le calendrier.
Merci d'avance et bonne journée,
Guy- Le plus simple est de sélectionner avant lancement de la macro, la plage verticale des dates à ajouter, auquel cas le code devient
Sub NouveauRDV_Calendrier()
Dim OkApp As New Outlook.Application
Dim Rdv As Outlook.AppointmentItem
Dim dates, date_i As Range
Set dates = Selection
For Each date_i In dates.Rows
If IsDate(date_i.Value) Then
Set Rdv = OkApp.CreateItem(olAppointmentItem)
With Rdv
.MeetingStatus = Meeting
.Subject = "Vacances"
.Start = date_i.Value
.AllDayEvent = True
.Categories = "Congé"
.ReminderSet = False
.Save
End With
End If
Next
Set OkApp = Nothing
End Sub
-
