Calendrier dans plage de cellules

RW02

XLDnaute Nouveau
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
 

Pièces jointes

  • Calendrier dans cellules.xlsx
    10.1 KB · Affichages: 44

Modeste geedee

XLDnaute Barbatruc
upload_2016-11-9_14-40-13.png
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
upload_2016-11-9_14-40-13.png


Ajouter ce code dans le module de feuille
VB:
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

XLDnaute Nouveau
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
VB:
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? :confused:
Merci pour votre aide
 

Pièces jointes

  • Suivi demandes clients.xlsm
    119.4 KB · Affichages: 35

RW02

XLDnaute Nouveau
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

XLDnaute Nouveau
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:D1000")) Is Nothing Then
fmSTD_Calendrier.SelectDateCalendrierCELL IIf(IsDate(Target.Value), Target.Value, Date)
Cancel = True
End If
End Sub
 

riton00

XLDnaute Impliqué
Re

Code:
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

XLDnaute Barbatruc
Bonsoir à tous,

Salut Riton !

et si tu veux sélectionner dans d'autres feuilles des range() différents exemple:
Code:
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
 

Discussions similaires

Statistiques des forums

Discussions
312 836
Messages
2 092 619
Membres
105 468
dernier inscrit
Leo M