Bonjour,
J'ai parcouru divers forums et tenter de faire une maccro me permettant de planifier à une date renseignée sur Excel un RDV Outlook. Jusque là tout va bien... Quand le RDV est créé, la colonne C s'incrémente d'un texte "OUI". J'ai une boucle qui permet de vérifier si la colonne C est "OUI" alors la macro ne créé rien. Or, la date peut changer (il s'agit de visite médicale où une fois passée, une nouvelle date viendra la remplacer pour la prochaine visite à venir) et auquel cas, il faut que la personne qui gérera le fichier modifie la date et enlève le "OUI". Ce qui n'est pas assez fiable. Peut-on demander à Excel de tester s'il y a un RDV déjà existant pour un nom de sujet (le sujet est "calculé" dans la maccro) et à une date donnée (celle en colonne B)? Si oui, comment?
Voici le module en place :
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
' Créer une instance d'Outlook
Set OutObj = CreateObject("outlook.application")
' Avec la feuille
With Sheets("Suivi")
DLig = .Range("A" & Rows.Count).End(xlUp).Row
' Pour chaque ligne
For Lig = 2 To DLig
' Si une date de relance existe
If .Range("B" & Lig) <> "" Then
' Si un RDV n'a pas déjà été créé
If .Range("C" & Lig) <> "Oui" Then
FlgRdv = True
Else
' Sinon, pas de RDV déjà créé
FlgRdv = False
End If
Else
' Sinon, pas de date de relance
FlgRdv = False
End If
' Si le FLAG est à vrai on créé le RDV
If FlgRdv Then
DateRdv = Range("B" & Lig)
Set OutAppt = OutObj.CreateItem(olAppointmentItem)
With OutAppt
.Subject = "Visite Médicale " & Sheets("Suivi").Range("A" & Lig)
.Start = DateRdv & " 08:00"
.Duration = 60
.ReminderSet = True
.Save
End With
' Créer le commentaire et inscrire Oui
On Error Resume Next
.Range("C" & Lig) = "Oui"
On Error GoTo 0
End If
Next Lig
End With
Set OutAppt = Nothing
End Sub
Je vous remercie par avance pour votre aide.
Bonne journée,
Audrey
EDIT : Ajout des balises de code (la coloration syntaxique).
Explications disponibles ICI
