Module de création de rendez-vous outlook

Bonjour a tous,

je suis relativement novice en VBA et je rencontre le problème suivant:

j'ai réussi (a force de fouiller sur le net et en prenant des partie de codes ça et la) a avoir un module qui sélectionne certaine cellule de mon classeur excel et qui créé une tache avec un rappel dans Outlook.

j'en suis la :

Sub Outlook_Appointment()

Dim olApp As Outlook.Application

Dim olAppItem As Outlook.AppointmentItem

Set olApp = GetObject("", "Outlook.Application")

Set olAppItem = olApp.CreateItem(olAppointmentItem)

With olAppItem

.Start = Range("'feuil6'!m4").Value

.Subject = Range("'feuil6'!c4").Value

.Duration = 1

.ReminderSet = True

.Save

End With

End Sub

le tout fonctionne a merveille. mon seul souci est que j'aimerais maintenant pouvoir étendre le tout a mon tableau entier

j'aimerais que la macro soit activé par le contenu d'une cellule dans laquelle j'ai un menu déroulant a 2 sélection possible (oui/non) genre si j'indique oui il créé un événement et si je dit non il n'en créé pas

Bonsoir,

une solution avec une macro évènementielle à mettre dans le code de "feuil6"

je fais l'hypothèse que c'est sur cette feuille qu'il y a le menu déroulant avec le choix "oui/non" et qu'il faut reprendre les infos en colonne M et C sur la même ligne.

Private Sub Worksheet_Change(ByVal Target As Range)
If UCase(Target) = "OUI" Then
Dim olApp As Outlook.Application

Dim olAppItem As Outlook.AppointmentItem

Set olApp = GetObject("", "Outlook.Application")

Set olAppItem = olApp.CreateItem(olAppointmentItem)

With olAppItem

.Start = Range("m" & Target.Row).Value

.Subject = Range("c" & Target.Row).Value

.Duration = 1

.ReminderSet = True

.Save

End With
end if
End Sub

Impeccable ça fonctionne.

il a seulement fallu que j'ajoute un END IF parce que je recevais un message d'erreur mais sinon tout fonctionne a merveille. Merci

patthecat a écrit :

Impeccable ça fonctionne.

il a seulement fallu que j'ajoute un END IF parce que je recevais un message d'erreur mais sinon tout fonctionne a merveille. Merci

effectivement il manquait un end if.

j'ai effectuer quelques modification pour rendre le tout plus "user friendly"

j'ai intégrer dans le code de la feuille :

Private Sub Worksheet_change(ByVal Target As Range)
Dim ligvid As Long
If Intersect(Target, Range("r4:r133")) Is Nothing Or Target.Count > 1 Then: Exit Sub
msg = "Voulez vous créé une tache outlook ?"
Style = vbYesNo + vbCritical + vbDefaultButton2
Title = "évenement outlook"
Response = MsgBox(msg, Style, Title)
If Response = vbYes Then
Outlook_Appointment
End If
End Sub

et mon module est le suivant:

Sub Outlook_Appointment()

Dim olApp As outlook.Application

Dim olAppItem As outlook.AppointmentItem

Set olApp = GetObject("", "Outlook.Application")

Set olAppItem = olApp.CreateItem(olAppointmentItem)

With olAppItem

.Start = Range("n" & Target.Row).Value

.Subject = Range("c" & Target.Row).Value

.Duration = 1

.ReminderSet = True

.Save

End With

End Sub

et la je fait ma modif dans ma plage R4:r133, la boite de dialogue apparait, je clique oui et PAF! erreur 424 lié a la ligne:

.Start = Range("n" & Target.Row).Value

je ne comprend pas trop ce qui cause cette erreur,

bien aimable a vous de me donner un coup de main!

Merci

bonsoir,

target est un objet qui n'est connu que dans worksheet_change

Il n'a pas de valeur dans outlook_appointment.

proposiiton de correction

Private Sub Worksheet_change(ByVal Target As Range)
Dim ligvid As Long
If Intersect(Target, Range("r4:r133")) Is Nothing Or Target.Count > 1 Then: Exit Sub
msg = "Voulez vous créé une tache outlook ?"
Style = vbYesNo + vbCritical + vbDefaultButton2
Title = "évenement outlook"
Response = MsgBox(msg, Style, Title)
If Response = vbYes Then
Outlook_Appointment(target.row)
End If
End Sub

 

Sub Outlook_Appointment(ligne)

Dim olApp As outlook.Application

Dim olAppItem As outlook.AppointmentItem

Set olApp = GetObject("", "Outlook.Application")

Set olAppItem = olApp.CreateItem(olAppointmentItem)

With olAppItem

.Start = Range("n" & ligne).Value

.Subject = Range("c" & ligne).Value

.Duration = 1

.ReminderSet = True

.Save

End With

End Sub
 

Ça fonctionne Merci.

Maintenant, est-il possible, de recevoir un Feedback de Outlook ?

quelque chose du genre : lorsque je marque la tache complété dans outlook, une case dans ma feuille affiche un message quelconque?

je ne suis pas vraiment sur de vouloir aller jusque la. (lire vraiment pas sur...) mais par simple curiosité, quelqu'un pourrais orienter mes recherches ou me donner une piste ?

Merci a vous tous