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.xlsBonjour.
Tu fais bien de te manifester. Comme j'avais lu "merci", je n'avais pas
été plus loin...
Je regarde.
DanielOups...plus personne pour me répondre ?
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" <dcolardelleZZZ@gmail.com> a écrit dans le message de news:
uCHtpF6hJHA.6128@TK2MSFTNGP02.phx.gbl...
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 ?
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.xlsBonjour.
Tu fais bien de te manifester. Comme j'avais lu "merci", je n'avais pas
été plus loin...
Je regarde.
DanielOups...plus personne pour me répondre ?
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.xlsBonjour.
Tu fais bien de te manifester. Comme j'avais lu "merci", je n'avais pas
été plus loin...
Je regarde.
DanielOups...plus personne pour me répondre ?
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: eLxe0XEiJHA.504@TK2MSFTNGP06.phx.gbl...
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" <dcolardelleZZZ@gmail.com> a écrit dans le message de news:
uCHtpF6hJHA.6128@TK2MSFTNGP02.phx.gbl...
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 ?
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.xlsBonjour.
Tu fais bien de te manifester. Comme j'avais lu "merci", je n'avais pas
été plus loin...
Je regarde.
DanielOups...plus personne pour me répondre ?
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)
DanielBon 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.xlsBonjour.
Tu fais bien de te manifester. Comme j'avais lu "merci", je n'avais
pas été plus loin...
Je regarde.
DanielOups...plus personne pour me répondre ?
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 (dcolardelleZZZ@free.fr, 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: eLxe0XEiJHA.504@TK2MSFTNGP06.phx.gbl...
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" <dcolardelleZZZ@gmail.com> a écrit dans le message de news:
uCHtpF6hJHA.6128@TK2MSFTNGP02.phx.gbl...
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 ?
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)
DanielBon 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.xlsBonjour.
Tu fais bien de te manifester. Comme j'avais lu "merci", je n'avais
pas été plus loin...
Je regarde.
DanielOups...plus personne pour me répondre ?