Calendrier dans plage de cellules

RW02 · 9 Novembre 2016

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 · 9 Novembre 2016

Bonjour RW,

Un fichier de Jacques Boisgontier adapté à ta demande

à+
Philippe

Modeste geedee · 9 Novembre 2016

RW02 à dit:
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

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 · 9 Novembre 2016

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 · 9 Novembre 2016

Modeste geedee à dit:
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?
Merci pour votre aide

riton00 · 9 Novembre 2016

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 · 9 Novembre 2016

riton00 à dit:
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 · 9 Novembre 2016

RW02 à dit:
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 · 9 Novembre 2016

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 · 9 Novembre 2016

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

RW02 · 9 Novembre 2016

J'avais essayé avec un ;
Merci beaucoup

Calendrier dans plage de cellules

RW02

XLDnaute Nouveau

Pièces jointes

phlaurent55

Nous a quittés en 2020

Pièces jointes

Modeste geedee

XLDnaute Barbatruc

RW02

XLDnaute Nouveau

RW02

XLDnaute Nouveau

Pièces jointes

riton00

XLDnaute Impliqué

Pièces jointes

RW02

XLDnaute Nouveau

RW02

XLDnaute Nouveau

riton00

XLDnaute Impliqué

Roland_M

XLDnaute Barbatruc

RW02

XLDnaute Nouveau

Discussions similaires