Calendrier dans plage de cellules

[RW02]

Bonjour,
Je cherche à mettre un calendrier dans un champ afin de pouvoir sélectionner la date. J'ai vu plusieurs tutoriels sur le net mais je n'arrive pas à mes fins !!! Suis pas très doué. 🙁
Je mets un petit fichier en pj.
Merci d'avance pour votre aide...
Bonne journée

 

[phlaurent55]

Bonjour RW,

Un fichier de Jacques Boisgontier adapté à ta demande

à+
Philippe

 

[Modeste geedee]

Bonjour,
Je cherche à mettre un calendrier dans un champ afin de pouvoir sélectionner la date. J'ai vu plusieurs tutoriels sur le net mais je n'arrive pas à mes fins !!! Suis pas très doué. 🙁
Je mets un petit fichier en pj.
Merci d'avance pour votre aide...
Bonne journée

inserer dans la feuille un controle activex : Monthview

Ajouter ce code dans le module de feuille

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("D4:D33")) Is Nothing Then
        If Target.Count = 1 Then
                Me.MonthView1.Value = IIf(Target.Value < Now, Now, Target.Value)
                Me.MonthView1.Visible = True
                Me.MonthView1.Left = Target.Offset(0, 1).Left
                Me.MonthView1.Top = Target.Offset(0, 1).Top
                DoEvents
        End If
End If
End Sub
Private Sub MonthView1_DateClick(ByVal DateClicked As Date)
On Error Resume Next
ActiveCell.Value = DateClicked
Me.MonthView1.Visible = False
End Sub

en cas de probleme d'installation :
https://support.microsoft.com/fr-fr/kb/2676583

 

[RW02]

Merci Philippe et Modeste
Modeste, j'ai testé ta solution mais j'ai un message Visual Basic et ça ne fonctionne pas !!!
J'ai dû commettre un erreur en copiant le code. 😕
Je mets mon fichier en pj.

 

[RW02]

Regarde la pièce jointe 976073
inserer dans la feuille un controle activex : Monthview
Regarde la pièce jointe 976073

Ajouter ce code dans le module de feuille

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("D4:D33")) Is Nothing Then
        If Target.Count = 1 Then
                Me.MonthView1.Value = IIf(Target.Value < Now, Now, Target.Value)
                Me.MonthView1.Visible = True
                Me.MonthView1.Left = Target.Offset(0, 1).Left
                Me.MonthView1.Top = Target.Offset(0, 1).Top
                DoEvents
        End If
End If
End Sub
Private Sub MonthView1_DateClick(ByVal DateClicked As Date)
On Error Resume Next
ActiveCell.Value = DateClicked
Me.MonthView1.Visible = False
End Sub

en cas de probleme d'installation :
https://support.microsoft.com/fr-fr/kb/2676583

Merci Modeste pour votre aide
Je n'arrive pas à mes fins lorsque j'utilise votre procédure.
Pouvez-vous vérifier dans le fichier joint si j'ai commis une erreur dans la mise en oeuvre? 😕
Merci pour votre aide

 

[riton00]

Bonsoir

Ici greffé sur ton fichier un calendrier de notre cher ami, Roland que je salut au passage
Fonctionne par double clic en colonne D

Cordialement

 

[RW02]

Bonsoir

Ici greffé sur ton fichier un calendrier de notre cher ami, Roland que je salut au passage
Fonctionne par double clic en colonne D

Cordialement

Génial, ça répond tout à fait à mes attentes. Je vais essayer de comprendre le fonctionnement et de l'adapter à d'autres projets.
Merci Riton et merci également aux autres contributeurs Philippe et Modeste
Bonne soirée à tous

 

[RW02]

Génial, ça répond tout à fait à mes attentes. Je vais essayer de comprendre le fonctionnement et de l'adapter à d'autres projets.
Merci Riton et merci également aux autres contributeurs Philippe et Modeste
Bonne soirée à tous

PS: juste une petite question !!! Que dois-je changer à ce qui suit pour appliquer ce calendrier à d'autres cellules de la même feuille (exemple : R3:R100)

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
If Not Application.Intersect(Target, Range("D3😀1000")) Is Nothing Then
fmSTD_Calendrier.SelectDateCalendrierCELL IIf(IsDate(Target.Value), Target.Value, Date)
Cancel = True
End If
End Sub

 

[riton00]

Re

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
If Not Application.Intersect(Target, Range("D3:D100,R3:R100")) Is Nothing Then
fmSTD_Calendrier.SelectDateCalendrierCELL IIf(IsDate(Target.Value), Target.Value, Date)
Cancel = True
End If
End Sub

Slts

 

[Roland_M]

Bonsoir à tous,

Salut Riton !

et si tu veux sélectionner dans d'autres feuilles des range() différents exemple:

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
F$ = LCase(Sh.Name) ' test en minuscule!
If F$ = "commandes" Then '< ici nom de ta feuille avec date en D3:D100
   If Not Application.Intersect(Target, Range("D3:D100,R3:R100")) Is Nothing Then
      fmSTD_Calendrier.SelectDateCalendrierCELL IIf(IsDate(Target.Value), Target.Value, Date):  Cancel = True
    End If
ElseIf F$ = "nom de ta feuille1" Then '< ici nom d'une autre feuille avec date en R3:R100
   If Not Application.Intersect(Target, Range("R3:R100")) Is Nothing Then
      fmSTD_Calendrier.SelectDateCalendrierCELL IIf(IsDate(Target.Value), Target.Value, Date): Cancel = True
    End If
ElseIf F$ = "nom de ta feuille2" Then '< ici nom d'une autre feuille ........
   If Not Application.Intersect(Target, Range("A1:A10")) Is Nothing Then
      fmSTD_Calendrier.SelectDateCalendrierCELL IIf(IsDate(Target.Value), Target.Value, Date): Cancel = True
   End If
End If
End Sub

 

[RW02]

J'avais essayé avec un ; 😉
Merci beaucoup