Discussion :

[patricktoulon]

Bonjour a tous
et voila maintenant il reconnais la date quelque soit le format de cette date dans le textbox et positionne le calendrier au mois et année du textbox
bien sur si il n'y a pas de date il se met en janvier et année en cours

code userform toujoursle meme et toujours pareil mettre "cal" dans le tag des textboxs qui destinés a être des calendriers

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Dim cl2 As New calendrier2
Private Sub UserForm_Activate()
cl2.createcalendrier Me
End Sub

code de la classe

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
 
'       '******************************** CREATION CONTROL CALENDRIER DYNAMIQUE************************************
'       '                      Auteur: Chamalin2@hotmail.fr alias patricktoulon sur developpez.com                *
'       '                                      exemplaire pour DVP.com                                            *
'       '                                      ----------------------                                             *
'       ' date de creation : 23/07/2016                                                                           *
'       ' derniere mise ajour:                                                                                    *
'       ' 1 aout 2016 : ajout  du placement relatif                                                               *
'       ' 2 aout 2016 :ajout du tiptext en cas de petite taille du calendrier                                     *
'       ' licence: libre a condition de citer l'auteur                                                            *
'       '                                                                                                         *
'       '                                                                                                         *
'       '                                       15/01/2017                                                        *
'       '                                  NOUVELLE VERSION  !!!!!                                                *
'       '          on peut maintenant l'utiliser sur plusieur textboxs  dynamiquement avec la meme classe         *
'       '**********************************************************************************************************
 
 
Option Explicit
Public WithEvents JRS As MSForms.Label
Public WithEvents formm As UserForm
Public WithEvents frame As MSForms.frame
Public WithEvents calendart As MSForms.TextBox
Public WithEvents listeA As MSForms.ComboBox
Public WithEvents listeM As MSForms.ComboBox
Public WithEvents listeF As MSForms.ComboBox
Public WithEvents memo As MSForms.TextBox
Private jr(42) As New calendrier2
Private tcal(50) As New calendrier2
Private usf As New calendrier2
 
Function NB_JOURS(mois, année)
    NB_JOURS = Day(DateSerial(année, mois + 1, 1) - 1)
End Function
Function createcalendrier(uf)
    Set usf.formm = uf
    Dim jourr, formT, fram, listm, lista, listf, i, bout As Object, M, leleft, thetop, lig, col, ctrl, T
    jourr = Array("lun.", "mar.", "mer.", "jeu.", "ven.", "sam.", "dim.")
    formT = Array("FORMAT", "dd/mm/yyyy", "dd-mm-yyyy", "d/m/yy", "yyyy/mm/dd", "yyyy-mm-dd", "ddd dd mmm yyyy", "dddd dd mmmm yyyy")
    Set fram = uf.Add("Forms.Frame.1", "cal")
    With fram: .Width = 160: .Height = 130: .BackColor = RGB(80, 80, 80): .BorderStyle = 1: .BorderColor = vbBlue: End With
    Set M = fram.Add("Forms.TextBox.1", "memo")
    Set usf.frame = fram
    '*********************************************ajout le la liste des mois *********************************************
    Set listm = fram.Add("Forms.combobox.1", "listemois")
    With listm
        .ListRows = 12: .Font.Size = 9: .TextAlign = 1: .Move 0, 0, (fram.Width / 3) + 10, 15
        .BackColor = RGB(150, 150, 150): .ForeColor = RGB(0, 0, 0)
        For i = 1 To 12: .AddItem Format("01/0" & i & "/2016", "mmmm"): Next
        .Value = Format(Date, "mmmm"): .BorderStyle = 1: .ListRows = UBound(formT)
    End With
    '*******************************************Ajout de la combobox année***************************************************
    Set lista = fram.Add("Forms.combobox.1", "listeAnnée")
    With lista
        .ListRows = 15: .Font.Size = 9: .TextAlign = 1: .Move listm.Width, 0, (fram.Width / 3) - 10, 15: .BackColor = RGB(150, 150, 150): .ForeColor = RGB(0, 0, 0):
        For i = 1800 To Val(Year(Date)) + 50: .AddItem i: Next
        .Value = Year(Date): .BorderStyle = 1
    End With
    '*******************************************Ajout de la combobox choix du format de sortie de la date ***************************************************
    Set listf = fram.Add("Forms.combobox.1", "listeFormat")
    With listf
        .ListRows = 15: .Font.Size = 9: .TextAlign = 1: .Move (fram.Width / 3) * 2, 0, (fram.Width / 3), 15: .BackColor = RGB(150, 150, 150): .ForeColor = RGB(0, 0, 0): .BorderStyle = 1
        .List = formT
        .ListIndex = 1
    End With
    '************************************************************************************************
    For i = 0 To UBound(jourr)    ' ajout de la ligne d'entetes  pour les jours en lettre
        Set bout = fram.Add("Forms.lABEL.1", jourr(i))
        With bout
            .Caption = jourr(i): .Tag = i + 1: .BorderStyle = 1: .BackStyle = 1: .BackColor = RGB(70, 70, 70): .BorderColor = RGB(0, 200, 255): .ForeColor = RGB(255, 255, 255)
            .TextAlign = 2: .FontSize = 8
            .Move leleft + (23 * i) - 1 * i, listf.Height + 1, 23, Round(fram.Height / 8)
        End With
    Next
    '**************************************************************************************************
    thetop = fram.Controls("lun.").Top + fram.Controls("lun.").Height + 2
    i = 0
    For lig = 1 To 6
        For col = 0 To 6
            i = i + 1
            Set bout = fram.Add("Forms.Label.1", "jour" & i)
            With bout
                .BorderStyle = 1: .BackStyle = 1: .BackColor = RGB(120, 120, 120): .BorderColor = RGB(255, 255, 255): .ForeColor = RGB(255, 255, 255)
                .TextAlign = 2: .FontSize = 7
                .FontSize = IIf(.FontSize < 7, 7, .FontSize)
                .Move leleft + (23 * col) - 1 * col, thetop, 23, Round(fram.Height / 8)
                'ajout des liste,frame,userform,textbox dans l'instance(i) de la classe calendrier du label
                With jr(i): Set .JRS = bout: Set .listeA = lista: Set .listeM = listm: Set .listeF = listf: Set .formm = uf: Set .memo = M: Set .frame = fram: End With
            End With
            If col = 6 Or col = 14 Or col = 21 Or col = 28 Or col = 35 Or col = 42 Then thetop = thetop + 15: leleft = 0
        Next col
    Next lig
    '****************************************************************************************
    For Each ctrl In uf.Controls
        If TypeName(ctrl) = "TextBox" And ctrl.Tag = "cal" Then
            T = T + 1: ctrl.Tag = Format(Date, "dd/mm/yyyy")
            With tcal(T): Set .calendart = ctrl: Set .listeA = lista: Set .listeM = listm: Set .frame = fram: Set .formm = uf: Set .memo = M: End With
        End If
    Next
    mise_a_jour fram
    fram.Visible = False
End Function
Private Sub JRS_Click()
    If JRS.Caption = "" Then frame.Visible = False: Exit Sub
    Dim F As String
    F = IIf(listeF.Value = "FORMAT", "dd/mm/yyyy", listeF.Value)
    formm.Controls(memo.Tag) = Format(JRS.Caption & "/" & listeM.ListIndex + 1 & "/" & listeA.Value, F)
    formm.Controls(memo.Tag).Tag = Format(JRS.Caption & "/" & listeM.ListIndex + 1 & "/" & listeA.Value, "dd/mm/yyyy")
    frame.Visible = False
    listeF.ListIndex = 0
End Sub
Private Sub JRS_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If JRS.BackColor = RGB(120, 120, 120) Then
        If frame.Tag <> "" Then
            frame.Controls(frame.Tag).BackColor = RGB(120, 120, 120): frame.Controls(frame.Tag).BorderColor = vbWhite
            If frame.Controls(frame.Tag).ForeColor <> vbGreen Then frame.Controls(frame.Tag).ForeColor = vbWhite
        End If
        If JRS.Caption <> "" Then JRS.BackColor = RGB(100, 100, 100): JRS.BorderColor = RGB(0, 200, 255)
        If JRS.ForeColor <> vbGreen Then JRS.ForeColor = RGB(255, 0, 100)
        JRS.Parent.Tag = JRS.Name
    End If
End Sub
Sub mise_a_jour(fram)
    Dim ctrl, i As Long, jj, decal
    For i = 1 To 42: fram.Controls("jour" & i).Caption = "": Next
    decal = Val(fram.Controls(Format(DateSerial(fram.Controls("listeAnnée").Value, fram.Controls("listemois").ListIndex + 1, 1), "ddd")).Tag)
    For i = 1 To NB_JOURS(fram.Controls("listemois").ListIndex + 1, fram.Controls("listeAnnée").Value)
        fram.Controls("jour" & i + decal - 1) = i
        If DateSerial(fram.Controls("listeAnnée").Value, fram.Controls("listemois").ListIndex + 1, i) = Date Then fram.Controls("jour" & i + decal - 1).ForeColor = vbGreen Else fram.Controls("jour" & i + decal - 1).ForeColor = vbWhite
        fram.Controls("jour" & i + decal - 1).ControlTipText = Format(DateSerial(fram.Controls("listeAnnée").Value, fram.Controls("listemois").ListIndex + 1, i), "dddd dd mmmm yyyy")
    Next
End Sub
Private Sub frame_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If frame.Tag <> "" Then
        frame.Controls(frame.Tag).BackColor = RGB(120, 120, 120): frame.Controls(frame.Tag).BorderColor = vbWhite
        If frame.Controls(frame.Tag).ForeColor <> vbGreen Then frame.Controls(frame.Tag).ForeColor = vbWhite
        frame.Tag = ""
    End If
End Sub
Private Sub listeM_Change()
    mise_a_jour listeM.Parent
End Sub
Private Sub listeA_Change()
    mise_a_jour listeM.Parent
End Sub
Private Sub calendart_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Dim Wi As Long, HT As Long
    Wi = calendart.Parent.Width: HT = calendart.Parent.Height
    memo.Tag = calendart.Name
    With frame
        .Visible = True
        .Left = IIf(Wi - calendart.Left + 10 >= .Width, calendart.Left, Wi - (frame.Width + 10))
        .Top = IIf(HT - calendart.Top + 10 >= .Height, calendart.Top, HT - (frame.Height + 10))
    End With
    formm.Repaint 'accelere l'affichage
    listeM.ListIndex = Month(calendart.Tag) - 1
    listeA.Value = Year(calendart.Tag)
End Sub
Private Sub formm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    frame.Visible = False
End Sub

demo

[Philippe Tulliez]

Bonjour Patrick,

@Philippe c'est assez étonnant ce que tu me dis

Je ne comprends pas non plus.
Je viens de recharger le code car la procédure JRS_Click que tu as publiée hier soir n'était pas la même que celle que j'ai chargée (Il est probable que j'aurais copié la version publiée le 15 janvier à 13h33. C'est dommage que tu ne mettes pas à jour les dates et n° de versions de tes mises à jour (Update) et améliorations (Upgrade)
Bref, cela fonctionne parfaitement.

[patricktoulon]

Bonjour Philippe

a oui je comprends mieux

je n'ajoute pas les date de modif car en fait au départ c'était un model pour wappymil+ ,je voulais garder ma version intacte mais au final son idée n'était pas mauvaise

nouvelle VERSION(3.0)

j'ai donc ajouté dans la version qui suit (version(3.0))

1. remise en place du system click droit pour ouvrir le calendrier ( il ne s'ouvre qu'au click droit sur les textboxs)
2. bloquer la possibilité d'écrire sur les textboxs calendrier avec le clavier
3. reconnaissance des date(tout format) pour le positionnement en terme de temps du calendrier
4. modifié les font afin que les combobox ne dépassent pas le calendrier sinon le move de l'usf me le recache apres click sur item quand la combobox développée dépassait le calendrier (listrows=12,font 7 ou 8 )
5. et plein de petite modifs imperceptibles mais qui sont nécessaires

code userform toujours le même

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Dim cl2 As New calendrier2
Private Sub UserForm_Activate()
cl2.createcalendrier Me
End Sub

code la classe

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
 
'       '******************************** CREATION CONTROL CALENDRIER DYNAMIQUE************************************
'       '                      Auteur: Chamalin2@hotmail.fr alias patricktoulon sur developpez.com                *
'       '                                      exemplaire pour DVP.com                                            *
'       '                                      ----------------------                                             *
'       ' date de creation : 23/07/2016                                                                           *
'       ' derniere mise ajour:                                                                                    *
'       ' 1 aout 2016 : ajout  du placement relatif                                                               *
'       ' 2 aout 2016 :ajout du tiptext en cas de petite taille du calendrier                                     *
'       ' licence: libre a condition de citer l'auteur                                                            *
'       '                                                                                                         *
'       '                                                                                                         *
'       '                                       15/01/2017                                                        *
'       '                                  NOUVELLE VERSION  !!!!!                                                *
'       '          on peut maintenant l'utiliser sur plusieur textboxs  dynamiquement avec la meme classe         *
'       '   modif 18/01/2017
'       ' impossibilité d'ecrire au cavier sur les textboxs calendrier
'       ' modification font et listrows des comboboxs
'       ' remise en place du system click droit (le calendrier s'ouvre au click droit sur le textbox
'       '**********************************************************************************************************
 
 
Option Explicit
Public WithEvents JRS As MSForms.Label
Public WithEvents formm As UserForm
Public WithEvents frame As MSForms.frame
Public WithEvents calendart As MSForms.TextBox
Public WithEvents listeA As MSForms.ComboBox
Public WithEvents listeM As MSForms.ComboBox
Public WithEvents listeF As MSForms.ComboBox
Public WithEvents memo As MSForms.TextBox
Private jr(42) As New calendrier2
Private tcal(50) As New calendrier2
Private usf As New calendrier2
 
Function NB_JOURS(mois, année)
    NB_JOURS = Day(DateSerial(année, mois + 1, 1) - 1)
End Function
Function createcalendrier(uf)
    Set usf.formm = uf
    Dim jourr, formT, fram, listm, lista, listf, i, bout As Object, M, leleft, thetop, lig, col, ctrl, T
    jourr = Array("lun.", "mar.", "mer.", "jeu.", "ven.", "sam.", "dim.")
    formT = Array("FORMAT", "dd/mm/yyyy", "dd-mm-yyyy", "d/m/yy", "yyyy/mm/dd", "yyyy-mm-dd", "ddd dd mmm yyyy", "dddd dd mmmm yyyy")
    Set fram = uf.Add("Forms.Frame.1", "cal")
    With fram: .Width = 160: .Height = 130: .BackColor = RGB(80, 80, 80): .BorderStyle = 1: .BorderColor = vbBlue: End With
    Set M = fram.Add("Forms.TextBox.1", "memo")
    Set usf.frame = fram
    '*********************************************ajout le la liste des mois *********************************************
    Set listm = fram.Add("Forms.combobox.1", "listemois")
    With listm
        .Font.Size = 7: .TextAlign = 1: .Move 0, 0, (fram.Width / 3) + 10, 15
        .BackColor = RGB(150, 150, 150): .ForeColor = RGB(0, 0, 0)
        For i = 1 To 12: .AddItem Format("01/0" & i & "/2016", "mmmm"): Next
        .Value = Format(Date, "mmmm"): .BorderStyle = 1: .ListRows = UBound(formT)
        .ListRows = 12:
    End With
    '*******************************************Ajout de la combobox année***************************************************
    Set lista = fram.Add("Forms.combobox.1", "listeAnnée")
    With lista
        .ListRows = 15: .Font.Size = 7: .TextAlign = 1: .Move listm.Width, 0, (fram.Width / 3) - 10, 15: .BackColor = RGB(150, 150, 150): .ForeColor = RGB(0, 0, 0):
        For i = 1800 To Val(Year(Date)) + 50: .AddItem i: Next
        .Value = Year(Date): .BorderStyle = 1
        .ListRows = 12:
    End With
    '*******************************************Ajout de la combobox choix du format de sortie de la date ***************************************************
    Set listf = fram.Add("Forms.combobox.1", "listeFormat")
    With listf
        .ListRows = 15: .Font.Size = 8: .TextAlign = 1: .Move (fram.Width / 3) * 2, 0, (fram.Width / 3), 15: .BackColor = RGB(150, 150, 150): .ForeColor = RGB(0, 0, 0): .BorderStyle = 1
        .List = formT
        .ListIndex = 0
        .ListRows = 10:
    End With
    '************************************************************************************************
    For i = 0 To UBound(jourr)    ' ajout de la ligne d'entetes  pour les jours en lettre
        Set bout = fram.Add("Forms.lABEL.1", jourr(i))
        With bout
            .Caption = jourr(i): .Tag = i + 1: .BorderStyle = 1: .BackStyle = 1: .BackColor = RGB(70, 70, 70): .BorderColor = RGB(0, 200, 255): .ForeColor = RGB(255, 255, 255)
            .TextAlign = 2: .FontSize = 8
            .Move leleft + (23 * i) - 1 * i, listf.Height + 1, 23, Round(fram.Height / 8)
        End With
    Next
    '**************************************************************************************************
    thetop = fram.Controls("lun.").Top + fram.Controls("lun.").Height + 2
    i = 0
    For lig = 1 To 6
        For col = 0 To 6
            i = i + 1
            Set bout = fram.Add("Forms.Label.1", "jour" & i)
            With bout
                .BorderStyle = 1: .BackStyle = 1: .BackColor = RGB(120, 120, 120): .BorderColor = RGB(255, 255, 255): .ForeColor = RGB(255, 255, 255)
                .TextAlign = 2: .FontSize = 7
                .FontSize = IIf(.FontSize < 7, 7, .FontSize)
                .Move leleft + (23 * col) - 1 * col, thetop, 23, Round(fram.Height / 8)
                'ajout des liste,frame,userform,textbox dans l'instance(i) de la classe calendrier du label
                With jr(i): Set .JRS = bout: Set .listeA = lista: Set .listeM = listm: Set .listeF = listf: Set .formm = uf: Set .memo = M: Set .frame = fram: End With
            End With
            If col = 6 Or col = 14 Or col = 21 Or col = 28 Or col = 35 Or col = 42 Then thetop = thetop + 15: leleft = 0
        Next col
    Next lig
    '****************************************************************************************
    For Each ctrl In uf.Controls
        If TypeName(ctrl) = "TextBox" And ctrl.Tag = "cal" Then
            T = T + 1: ctrl.Tag = Format(Date, "dd/mm/yyyy")
            With tcal(T): Set .calendart = ctrl: Set .listeA = lista: Set .listeM = listm: Set .frame = fram: Set .formm = uf: Set .memo = M: End With
        End If
    Next
    mise_a_jour fram
    fram.Visible = False
End Function
Private Sub JRS_Click()
    If JRS.Caption = "" Then frame.Visible = False: Exit Sub
    Dim F As String
    F = IIf(listeF.Value = "FORMAT", "dd/mm/yyyy", listeF.Value)
    formm.Controls(memo.Tag) = Format(JRS.Caption & "/" & listeM.ListIndex + 1 & "/" & listeA.Value, F)
    formm.Controls(memo.Tag).Tag = Format(JRS.Caption & "/" & listeM.ListIndex + 1 & "/" & listeA.Value, "dd/mm/yyyy")
    frame.Visible = False
    listeF.ListIndex = 0
End Sub
Private Sub JRS_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If JRS.BackColor = RGB(120, 120, 120) Then
        If frame.Tag <> "" Then
            frame.Controls(frame.Tag).BackColor = RGB(120, 120, 120): frame.Controls(frame.Tag).BorderColor = vbWhite
            If frame.Controls(frame.Tag).ForeColor <> vbGreen Then frame.Controls(frame.Tag).ForeColor = vbWhite
        End If
        If JRS.Caption <> "" Then JRS.BackColor = RGB(100, 100, 100): JRS.BorderColor = RGB(0, 200, 255)
        If JRS.ForeColor <> vbGreen Then JRS.ForeColor = RGB(255, 0, 100)
        JRS.Parent.Tag = JRS.Name
    End If
End Sub
Sub mise_a_jour(fram)
    Dim ctrl, i As Long, jj, decal
    For i = 1 To 42: fram.Controls("jour" & i).Caption = "": Next
    decal = Val(fram.Controls(Format(DateSerial(fram.Controls("listeAnnée").Value, fram.Controls("listemois").ListIndex + 1, 1), "ddd")).Tag)
    For i = 1 To NB_JOURS(fram.Controls("listemois").ListIndex + 1, fram.Controls("listeAnnée").Value)
        fram.Controls("jour" & i + decal - 1) = i
        If DateSerial(fram.Controls("listeAnnée").Value, fram.Controls("listemois").ListIndex + 1, i) = Date Then fram.Controls("jour" & i + decal - 1).ForeColor = vbGreen Else fram.Controls("jour" & i + decal - 1).ForeColor = vbWhite
        fram.Controls("jour" & i + decal - 1).ControlTipText = Format(DateSerial(fram.Controls("listeAnnée").Value, fram.Controls("listemois").ListIndex + 1, i), "dddd dd mmmm yyyy")
    Next
End Sub
Private Sub frame_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If frame.Tag <> "" Then
        frame.Controls(frame.Tag).BackColor = RGB(120, 120, 120): frame.Controls(frame.Tag).BorderColor = vbWhite
        If frame.Controls(frame.Tag).ForeColor <> vbGreen Then frame.Controls(frame.Tag).ForeColor = vbWhite
        frame.Tag = ""
    End If
End Sub
Private Sub listeM_Change()
    mise_a_jour listeM.Parent
End Sub
Private Sub listeA_Change()
    mise_a_jour listeM.Parent
End Sub
Private Sub calendart_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
KeyAscii = 0
End Sub
Private Sub calendart_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If Button = 2 Then
        Dim Wi As Long, HT As Long
        Wi = calendart.Parent.Width: HT = calendart.Parent.Height
        memo.Tag = calendart.Name
        With frame
            .Visible = True
            .Left = IIf(Wi - calendart.Left + 10 >= .Width, calendart.Left, Wi - (frame.Width + 10))
            .Top = IIf(HT - calendart.Top + 10 >= .Height, calendart.Top, HT - (frame.Height + 10))
        End With
        formm.Repaint    'accelere l'affichage
        listeM.ListIndex = Month(calendart.Tag) - 1
        listeA.Value = Year(calendart.Tag)
    End If
End Sub
Private Sub formm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    frame.Visible = False
End Sub

voila maintenant il est au top

je rappelle tout de meme pour ceux qui l'utilisent déjà et voudraient utiliser la nouvelle version qu' il suffît simplement de changer le code de la classe pour celle ci et rien d'autre tout ce passe toujours de la

même manière : juste mettre "cal" dans le/les tags du/des textboxs pour qu'il soient interprétés comme des calendrier

pour voir et me remémorer j'ai regardé le comportement du control calendrier office 2007 chez moi
je pense que mon calendrier n'a rien a envier a ce control

d'autant plus que les fonctions ou constantes et contrôles utilisés sont basics en terme de vba et donc compatible avec toutes version de office Excel ce qui n'est pas le cas des controls calendrier ou calendar ou datepicker si tant est que l'un de ces contrôles soit dispos dans l'environnement

voila si vous avez d'autre suggestion concernant mon module classe calendrier je suis a l'écoute

[goninph]

Hello,

Je vois que vous parlez de calendrier, avec OFFICE365 le calendrier est génial, on peux tout afficher,les N° de semaine, un mois, 2 mois ........ jusqu'à 12 mois

Bon dimanche Philippe

[patricktoulon]

Hello,

Je vois que vous parlez de calendrier, avec OFFICE365 le calendrier est génial, on peux tout afficher,les N° de semaine, un mois, 2 mois ........ jusqu'à 12 mois

Voir fichier joint

Bon dimanche Philippe

Bonjour philippe et merci pour intervention

on est dans les contribution vba EXCEL ici et non office 365 ton fichier ne m'est d'aucune utilité sachant pour sur que je n'ai pas ce contrôles

d'autant plus que dans cette contribution il est question de construire son propre calendrier dynamiquement je précise au cas ou il n'est nullement question d'utiliser un control calendrier quelconque

seulement avec des controls frames , label , combobox que toute version Excel possèdent pour qu'il soit compatible avec toute c'est quand même le but de cette contribution

et comme c'est une contribution dont je suis l'auteur et non une discussion je ne souhaite pas voir d'autre fichiers que les miens éventuellement si non les visiteurs vont pas savoir quoi prendre

donc je t'en serais gré si tu t l'enlevais

par contre si tu veux poster quelques captures d'écran pour voir et démontrer ce qu'il peut faire je ne suis pas contre a fin d'ajouter ou améliorer le mien


j'attends tes captures (images)

[patricktoulon]

re
OK capture vu

ben en tte nous il est bien moche ce control l'idée de la semaine n'est pas mal en face de chaque ligne je prends je vais travailler dessus

pour supprimer ton fichier tu va a tableau de bord puis sur cette fenêtre a gauche tu descends a "piece jointes" ,tu click

dans cette fenêtre tu a toutes les pièces jointes que tu a donné avec le titre de la discussion dans la quelle tu l'a mis tu coche le petit carré a droite

puis tu descend a supprimer en bas de cette page a droite

[goninph]

Re

Voilà c'est fait.

L'idée du format de la date est excellente.

Un mois affiché n'est pas suffisant, il faudrait affiché 3 mois au minimum, c'est mon avis d'utilisateur

Pour avoir trouvé et modifié des USF calendar, le calendrier Excel365 est pour moi et jusqu'à ce jour le seul qui répond à mes attentes, car

Dans le calendrier Excel :

- Les flèches gauche et droite sont très utile pour passer de 3 mois en 3 mois, ou de mois en mois, ou de ... en ... de mois

- Si tu cliques sur le nom du mois, une liste déroulante affiche les mois, comme sur le tien, idem pour les années

- La date entourée de rouge est aujourd'hui

- La date en blanc est la date que contient la cellule cliquée

- Si pas de date dans la cellule, le calendrier s'affiche avec la date du jour

A+Philippe

[patricktoulon]

re
perso je préfère choisir directement le mois dans la combo
cliquer 4 fois sur la flèche pour atteindre décembre
ou afficher les 12 mois au calendrier

dans mon calendrier la date du jour est en vert ouvre le a janvier tu verra
il y a l'effet mouse over pour voir ou est vraiment la souris et quel jour est vraiment survolé quand on le fait petit c'est utile


tu a un drôle sens de la pratique toi

tout ce que je vais garder de ton calendrier c'est l'idée de la semaine le reste c'est a JETTER pour moi

merci pour tes retours

[patyom]

Bonjour,
J'ai chargé votre fichier "un calendrier pour tous" qui m'a l'air très bien suivant la démo mais il plante là :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
 
Private Sub UserForm_Activate()
   cl.creation_calandrier Me, Me.calendar   <-------  plantage dans cette ligne
End Sub

Je ne saisi pas trop l'utilisation d'un module de classe ?

J'ai oublié de vous dire que je suis sous MAC Excel 2011 Version 14.0

Avez-vous une idée ?

Merci

[patricktoulon]

Bon jour

pour Mac Mac je sais pas

par contre auriez vous oubliez de nommer le control "calendar" par hasard

mais c'est quoi déjà ce "me.calendar" si c'est un calendrier je ne vois pas l'intérêt d'utiliser ma classe

[Beraldix]

Bonjour Patrick,
Tout d'abord un grand merci pour cette contribution qui m'a permis de retrouver une fonction calendrier digne de ce nom.

J'ai cherché un peu partout dans le code ce qui ne fonctionnait pas pour moi, mais je ne trouve rien d'anormal.

Sur tous les Textbox de type date de mon Userform, le calendrier s'affiche avec la date du jour et pas la date présente dans le Textbox.
Une idée ?

Je met un exemple de mon fichier pour aider à la résolution si c'est possible.

Gestion des Adhérents 2018 V2.4 (exemple).xlsm

Dans cet exemple, j'ai déplacer la position du calendrier vers le bas afin de pouvoir voir la le champs date existant, ce qui oblige à se déplacer vers le calendrier en maintenant le click souris, mais ça me permet de vérifier la date et la saisie

Merci par avance

[patricktoulon]

Bonjour
je ne peut pas te dire ce qui va pas chez toi chez moi ton userform fonctionne

mon calendrier s'affiche bien pres du textbox et le calendrier se postionne bien dans le mois present dans la date deja inscrite
bref il fonctionne tres bien

si tu veux deplacer le calendrier ailleur tu remet en cause tout mon procedé avec mouse move sur userform et autre dans la classe ce qui a pour effet de le faire disparaitre forcement
capture


j'ai modifié ces deux lignes dans la classe

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 .Top = IIf(HT - calendart.Top + 10 >= .Height, calendart.Top, HT - (frame.Height + 10)) - 5
            .Top = IIf(HT - calendart.Top + 11 >= .Height, calendart.Top + 20, HT - (frame.Height + 10)) - 5

donc pour repondre a ta question non tu ne peux placer le calendrier autrement que ce qui est calculé
il faudrait tout reprendre le principe alors qu'il convient au plus grand nombre
voila la capture te montre que ca marche

j'ai vu aussi un autre userform calendrier a quoi sert il celui la

[Beraldix]

Merci pour ce retour rapide.
J'ai remis la version d'origine de ton code dans le module de classe pour être certain de ne pas faire d'impair (mon seul but de la modification était de voir ce qu'il y avait dans le champs date pour les tests et non de le modifier définitivement : l'affichage du calendrier tel qu'il est prévu en standard me convient aussi).

Par contre j'ai toujours le même problème.

Si je modifie une date avec le calendrier, après sur le Textbox en question, je suis bien positionné à la bonne date sélectionnée, par contre les autres TextBox de type Date sont aussi positionné à cette date.
Si je passe à un autre enregistrement, il m'affiche toujours la date du jour sur tous les TextBox de type Date, et si je reviens sur l'enregistrement que j'avais modifié, il propose de nouveau le calendrier positionné à la date du jour.

Il doit y avoir une incompatibilité dans ma version d'excel peut-être :

L'autre userform.calendrier qui était dans le fichier était un test : je l'ai supprimé mais ça n'a pas d'effet.

Si tu as une idée, je suis preneur, sinon je ferai avec, c'est déjà bien d'avoir cette fonction calendrier, et en principe je n'ai à saisir que des dates proches de la date du jour.

Je te remercie encore pour cette contribution et ce partage.

[patricktoulon]

re
Bonsoir
etonnant il ne devrait pas y avoir d'incompatibilité justement car j'utilise des controls communs a toute versions de excel c'est l'interet de cette contribution

[WuKoDLaK]

Bonjour Patrick,

je suis actuellement en train d'essayer de trouver une solution à la non disponibilité des dateTimePicker sur office 2010 et +.
ton topic et donc ton travail sont tout simplement énorme et excellent ! bravo.

il répond totalement à ce que je recherche, avec un bémol.

actuellement la date pour moi est affichée dans une cellule sur une feuille directement.

Est il possible lors d'un clique/ double clique ou tout autre appel sur la dite cellule d'afficher et de paramétrer le calendrier avec le contenu de la cellule ?
le but ne pas passer par j'ouvre le userform je clique droit sur la cellule et je sélectionne la date.

- Format cellule " dddd dd mmmm yyyy " (masquer le choix utilisateur).
- Userform qui affiche directement le calendrier lors d'un clique ou double clique sur cellule.
- Modification du contenu de la cellule suivant le choix utilisateur.

exemple visuel



cordialement,

Ronan

[goninph]

Hello,

Bonne année !

J'utilise les 2 calendriers de ce fichier.

A tester, ça peut aider.

Meilleures salutations
Philippe

Calendrier Pippo.xlsm

[patricktoulon]

bonjour goninph
ca n'a rien a voir avec cette contribution qui a pour but justement de se passer de control existant comme les monthview et autres datepiker
hors !! toi dans ton fichier tu utilise un monthview!!!!!

[CmzxNene]

Bonjour Patrick,

Super travail !
Je cherchais depuis un moment un usf calendrier pour palier l'absence des ocx sous un Excel 64 bits

Je suis entrain de paramétrer mon appli avec ton calendrier et je t'explique mon souhait.
J'ai un USF qui sert à remplir une fiche vierge et la date que j'utilise est celle du jour ou des quelques jours précédents
Donc la date (date du jour) qui s'affiche à l'ouverture de ton calendrier me va très bien.

En revanche, j'utilise ton calendrier dans un deuxième USF pour valider la fiche définitivement.
Cela peut être fait plusieurs semaines/mois après.
Je souhaiterais donc qu'à l'initialisation de ton calendrier, la date qui s'affiche soit celle (exemple bien sur) du champ ValiDate du USF ValidationFiche

Par la même occasion, lorsque je clique sur le jour choisi, je voudrais que la date s'affiche dans mon champ ValiDate (pas de pb, ça je sais faire) mais qu'en même temps ton USF calendrier se ferme.
J'ai essayé plusieurs méthode dont le Hide mais j'ai un bug si je reclique sur le calendrier (ce doit être un pb de réinitialisation du calendrier ????)

A te lire
Bien cordialement

Hervé

[patricktoulon]

Bonjour Hervé

depuis j'ai opté pour une entière et complète méthode dialogue
alors le principe se base sur le mode modal true du UserForm sur ce point on ne peut déroger a la règle
cela dit depuis j'ai conclu diverses pseudo boites de dialogue dont un calendrier sans module classe et autre entièrement autonome
il se manipule comme une fonction ou boite de dialog "with object ....end with" a la fin on a le résultat tu devrait aller faire un tour sur mon blog

j'ai donc revu la copie (plusieurs fois)
j'ai donc maintenant un module UserForm que j'utilise comme une fonction(dialog)
cet UserForm est complètement indépendant pas besoins d'autre module de gestion(classe,etc...)
voila comment je l'utilise en cliquant droite dans un textbox dans un autre UserForm

donc mon UserForm s'appelle calendrier

exemple d'appel dans un autre UserForm:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
 
Private Sub TextBox1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If Button = 2 Then
        With Calendrier
            Set .Destination = TextBox1
            .remote = True
            .Show
            If .DateResult <> False Then TextBox1.Value = .DateResult
            Unload Calendrier
        End With
    End If
End Sub
End Sub

.remote doit être a true si tu veux que le calendrier se mettre au mois et année de la date déjà présente dans le textbox
tu a 3 retours possibles au niveau des format de date
0 ,1,2 correspondant a Application.International(xlDateOrder) "dd/mm/yyyy" "mm/dd,yyyy" ,"yyyy/mm,dd"
les retours seront donc

1. .regionDate0
2. .regionDate1
3. .regionDate2

avec ces trois retours possibles tu a la possibilité de forcer un séparateur de ton choix " - , / , " " , etc..."tout ce que tu veux en fait

je précise aussi que le calendrier est valable pour les cellule aussi de la même manière
comme dans cet exemple en colonne A:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    Dim dat
    If Target.Column = 1 And Target.Cells.Count = 1 Then
        Cancel = True
        With Calendrier
            Set .Destination = Target
            .remote = IIf(Target.Value <> "", True, False) 'ne met pas cette ligne  si tu veux que le calendrier se mette a la date du jour a son affichage
            .Show
            If .DateResult <> False Then Target = .DateResult
            Unload Calendrier
        End With
    End If
End Sub

ci joint un exemple d'utilisation avec un UserForm contenant plusieurs textboxs avec appel conditionné(format,langue,separateur) et donc ce calendrier
démo utilisation dans cellule

démo d'utilisation dans textbox d'un UserForm


voila c'est mon dernier en date

[CmzxNene]

Re Patrick,

Merci à toi de ta réponse rapide.
Je ne savais pas que tu avais revu ton calendrier sans module de classe et celui-ci me paraît plus simple d'utilisation pour mes développements.
J'ai tout le WE pour choisir celui qui va être le plus pertinent pour les utilisateurs de mon appli.

C'est du très bon travail et je te félicite.

Merci encore à toi et je reviens vers toi si j'éprouve certaines difficultés à le gérer

Bien à toi
Hervé