Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

liaison entre excel et outlook

33 réponses
Avatar
Alain Camélique
bonjour,
voilà ma question. Je souhaite inscrire dans mon tableau excel une date de
rappel pour une ligne précise. Est-il possible de synchroniser directement
cette date dans Outlook - via une macro ou autre? Comme cela j'aurai
directement le rappel inscit dans mon calendrier.
J'ai office 2007. Merci de vos réponses

3 réponses

1 2 3 4
Avatar
Alain Camélique
Bon ben voilà je me suis à nouveau surestimé.
Comment copier le code dans mon classeur d'origine?
Il est vrai que j'ai 1 feuille par mois avec des liaison pour un
récapitulatif et je n'ai pas vraiment envie de tout refaire.






"Alain Camélique" <info@(àsupprimer)etancheite-camelique.ch> a écrit dans le
message de news:
Alors là Daniel... je ne sais comment te remercier.
Ta macro est parfaite. c'est exactement ce que je souhaitais.
Cette fois je te dis merci... mille fois merci.
Je vais essayer de copier le code dans mon classeur. Si je n'y arrive pas
je te relancerai



"Daniel.C" a écrit dans le message de news:

Ou plutôt, la réponse était mauvaise.
Il faut mettre le code suivant dans le module de la feuille :

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 6 And Target.Column <> 12 Then Exit Sub
If Target.Row < 5 Or Target.Count > 1 Then Exit Sub
If Cells(Target.Row, 6) = "" Or Cells(Target.Row, 12) = "" Then Exit
Sub
If Not IsDate(Cells(Target.Row, 12)) Then Exit Sub
Dim OlApp As Object
Dim NS As Object, ObjRDV As Object
Set OlApp = CreateObject("Outlook.Application")
Set NS = OlApp.GetNamespace("MAPI")
Set ObjRDV = OlApp.CreateItem(olAppointmentItem)
With ObjRDV
.Subject = Cells(Target.Row, 6)
'.Body = "texte"
.Start = Cells(Target.Row, 12)
.Duration = 30
.ReminderMinutesBeforeStart = 0
.ReminderSet = True
.Display 'mettre en commentaire après mise au point
End With
ObjRDV.Save
End Sub

Il faut, de plus, mettre la colonne L au format date.
Vooici le classeur modifié. Le RDV est créé quand la cellule de la
colonne L et celle de la colonne F sont remplies.

Daniel


http://www.cijoint.fr/cjlink.php?file=cj200902/cijbsgMIIP.xls

Bonjour.
Tu fais bien de te manifester. Comme j'avais lu "merci", je n'avais pas
été plus loin...
Je regarde.
Daniel

Oups...plus personne pour me répondre ?















Avatar
Daniel.C
Dans ce cas, il faut enlever la macro de la feuille et mettre le code
suivant dans le module "ThisWorkbook" :

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As
Range)
If Sh.Name = "Récapitulatif" Then Exit Sub
If Target.Column <> 6 And Target.Column <> 12 Then Exit Sub
If Target.Row < 5 Or Target.Count > 1 Then Exit Sub
If Cells(Target.Row, 6) = "" Or Cells(Target.Row, 12) = "" Then
Exit Sub
If Not IsDate(Cells(Target.Row, 12)) Then Exit Sub
Dim OlApp As Object
Dim NS As Object, ObjRDV As Object
Set OlApp = CreateObject("Outlook.Application")
Set NS = OlApp.GetNamespace("MAPI")
Set ObjRDV = OlApp.CreateItem(olAppointmentItem)
With ObjRDV
.Subject = Cells(Target.Row, 6)
'.Body = "texte"
.Start = Cells(Target.Row, 12)
.Duration = 30
.ReminderMinutesBeforeStart = 0
.ReminderSet = True
.Display 'mettre en commentaire après mise au point
End With
ObjRDV.Save
End Sub

Note que, s'il y a des feuilles auxquelles la macro ne doit pas
s'appliquer, il faut les exclure en tête du code; j'ai mis un exemple :
If Sh.Name = "Récapitulatif" Then Exit Sub
Le classeur modifié est là :
http://www.cijoint.fr/cjlink.php?file=cj200902/cij2UjPbOQ.xls
Si tu rencontres des problèmes, dis-le, tu peux éventuellement
m'envoyer ton classeur par mail (, en enlevant
les ZZZ)
Daniel

Bon ben voilà je me suis à nouveau surestimé.
Comment copier le code dans mon classeur d'origine?
Il est vrai que j'ai 1 feuille par mois avec des liaison pour un
récapitulatif et je n'ai pas vraiment envie de tout refaire.






"Alain Camélique" <info@(àsupprimer)etancheite-camelique.ch> a écrit dans le
message de news:
Alors là Daniel... je ne sais comment te remercier.
Ta macro est parfaite. c'est exactement ce que je souhaitais.
Cette fois je te dis merci... mille fois merci.
Je vais essayer de copier le code dans mon classeur. Si je n'y arrive pas
je te relancerai



"Daniel.C" a écrit dans le message de news:

Ou plutôt, la réponse était mauvaise.
Il faut mettre le code suivant dans le module de la feuille :

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 6 And Target.Column <> 12 Then Exit Sub
If Target.Row < 5 Or Target.Count > 1 Then Exit Sub
If Cells(Target.Row, 6) = "" Or Cells(Target.Row, 12) = "" Then Exit
Sub
If Not IsDate(Cells(Target.Row, 12)) Then Exit Sub
Dim OlApp As Object
Dim NS As Object, ObjRDV As Object
Set OlApp = CreateObject("Outlook.Application")
Set NS = OlApp.GetNamespace("MAPI")
Set ObjRDV = OlApp.CreateItem(olAppointmentItem)
With ObjRDV
.Subject = Cells(Target.Row, 6)
'.Body = "texte"
.Start = Cells(Target.Row, 12)
.Duration = 30
.ReminderMinutesBeforeStart = 0
.ReminderSet = True
.Display 'mettre en commentaire après mise au point
End With
ObjRDV.Save
End Sub

Il faut, de plus, mettre la colonne L au format date.
Vooici le classeur modifié. Le RDV est créé quand la cellule de la colonne
L et celle de la colonne F sont remplies.

Daniel


http://www.cijoint.fr/cjlink.php?file=cj200902/cijbsgMIIP.xls

Bonjour.
Tu fais bien de te manifester. Comme j'avais lu "merci", je n'avais pas
été plus loin...
Je regarde.
Daniel

Oups...plus personne pour me répondre ?

















Avatar
Alain Camélique
j'arrive pas..
je t'ai envoyé mon classeur
A+




"Daniel.C" a écrit dans le message de news:

Dans ce cas, il faut enlever la macro de la feuille et mettre le code
suivant dans le module "ThisWorkbook" :

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As
Range)
If Sh.Name = "Récapitulatif" Then Exit Sub
If Target.Column <> 6 And Target.Column <> 12 Then Exit Sub
If Target.Row < 5 Or Target.Count > 1 Then Exit Sub
If Cells(Target.Row, 6) = "" Or Cells(Target.Row, 12) = "" Then Exit
Sub
If Not IsDate(Cells(Target.Row, 12)) Then Exit Sub
Dim OlApp As Object
Dim NS As Object, ObjRDV As Object
Set OlApp = CreateObject("Outlook.Application")
Set NS = OlApp.GetNamespace("MAPI")
Set ObjRDV = OlApp.CreateItem(olAppointmentItem)
With ObjRDV
.Subject = Cells(Target.Row, 6)
'.Body = "texte"
.Start = Cells(Target.Row, 12)
.Duration = 30
.ReminderMinutesBeforeStart = 0
.ReminderSet = True
.Display 'mettre en commentaire après mise au point
End With
ObjRDV.Save
End Sub

Note que, s'il y a des feuilles auxquelles la macro ne doit pas
s'appliquer, il faut les exclure en tête du code; j'ai mis un exemple :
If Sh.Name = "Récapitulatif" Then Exit Sub
Le classeur modifié est là :
http://www.cijoint.fr/cjlink.php?file=cj200902/cij2UjPbOQ.xls
Si tu rencontres des problèmes, dis-le, tu peux éventuellement m'envoyer
ton classeur par mail (, en enlevant les ZZZ)
Daniel

Bon ben voilà je me suis à nouveau surestimé.
Comment copier le code dans mon classeur d'origine?
Il est vrai que j'ai 1 feuille par mois avec des liaison pour un
récapitulatif et je n'ai pas vraiment envie de tout refaire.






"Alain Camélique" <info@(àsupprimer)etancheite-camelique.ch> a écrit dans
le message de news:
Alors là Daniel... je ne sais comment te remercier.
Ta macro est parfaite. c'est exactement ce que je souhaitais.
Cette fois je te dis merci... mille fois merci.
Je vais essayer de copier le code dans mon classeur. Si je n'y arrive
pas je te relancerai



"Daniel.C" a écrit dans le message de news:

Ou plutôt, la réponse était mauvaise.
Il faut mettre le code suivant dans le module de la feuille :

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 6 And Target.Column <> 12 Then Exit Sub
If Target.Row < 5 Or Target.Count > 1 Then Exit Sub
If Cells(Target.Row, 6) = "" Or Cells(Target.Row, 12) = "" Then Exit
Sub
If Not IsDate(Cells(Target.Row, 12)) Then Exit Sub
Dim OlApp As Object
Dim NS As Object, ObjRDV As Object
Set OlApp = CreateObject("Outlook.Application")
Set NS = OlApp.GetNamespace("MAPI")
Set ObjRDV = OlApp.CreateItem(olAppointmentItem)
With ObjRDV
.Subject = Cells(Target.Row, 6)
'.Body = "texte"
.Start = Cells(Target.Row, 12)
.Duration = 30
.ReminderMinutesBeforeStart = 0
.ReminderSet = True
.Display 'mettre en commentaire après mise au point
End With
ObjRDV.Save
End Sub

Il faut, de plus, mettre la colonne L au format date.
Vooici le classeur modifié. Le RDV est créé quand la cellule de la
colonne L et celle de la colonne F sont remplies.

Daniel


http://www.cijoint.fr/cjlink.php?file=cj200902/cijbsgMIIP.xls

Bonjour.
Tu fais bien de te manifester. Comme j'avais lu "merci", je n'avais
pas été plus loin...
Je regarde.
Daniel

Oups...plus personne pour me répondre ?






















1 2 3 4