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("D31000")) 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