Un calendar pour tous ( control calendrier )

**meteo62** · 13/01/2017, 12h54

Bonjour
Votre calendrier et formidablement bien fait, très bon travail

Malgré la prise de contact par MP et par Mail à l’auteur du « calendrier pour tous » qui n’a certainement pas assez de temps pour répondre, je poste ce message dans le fil de la discussion.

Dans un userform je mets 2 textbox avec 2 calendriers (2 modules différents) et cela fonctionne.

Ce qui ne fonctionne pas c’est dans le calendrier de droite quand on sélectionne Fevrier 2020 le calendrier se met à jour mais garde les jour 30 et 31.
Mais si on clique sur le 30/2/2020 il envoie bien dans la textbox2 la date du 1/03/2020

Merci de votre aide

**meteo62** · 14/01/2017, 11h46

Dans cet exemple a 2 (classe calendrier dynamique2) calendrier j’aimerai savoir s’il est possible de fermer un des 2 calendriers avec un bouton

Merci de votre aide ou de toute autre suggestion

**meteo62** · 14/01/2017, 19h48

Le problème a été résolue sur un autre forum, et par souci d’honnêteté envers ce forum le met à disposition le fichier rectifié

-----------------------------------------------------------------------------------------------------------
Problème résolue par BOB71AU
« Le problème c'est que des valeurs de mois années ctrl et autres sont affectés au premier calendrier

mais tu utilises les mêmes variables pour le deuxième calendrier

j'ai donc mis des "s" un peu partout sur le deuxième module de class »
-----------------------------------------------------------------------------------------------------------

Et oui contrairement à d’autre j’ai au moins l’honnêteté de répondre au mail ou aux MP

Reste le problème pour arrête le module de classe

Amicalement

**patricktoulon** · 15/01/2017, 01h05

Et oui contrairement à d’autre j’ai au moins l’honnêteté de répondre au mail ou aux MP

alors c'est la meilleure !!!!!
tu utilise mon module avec des "s"

que j'ai créé et donner avec la meilleur intention du monde et gratuitement et toi tu me sert une parole comme ca
et en plus tu distribue sans demander a l'auteur (qui n'est personne d'autre que moi même) une version trafiquée !!!!!
puisque c'est comme ca déjà tu me l'enlève vite ce fichier faut il que je cite certains articles de certaine lois????

et même sans aller jusque la certain paragraphe aussi sur la charte du forum au sujet des demandes techniques par MP: la tu seulement lu la charte ???

vire moi ton classeur de Ma contribution les 3 fichiers pour être précis

surtout que je crois te l'avoir dis il n'est nullement nécessaire de doubler les modules classe quelques motif dans le premier et c'était bon

c'est du n'importe quoi ton doublage tu pollue ma contrib

**meteo62** · 15/01/2017, 10h18

Bonjour
Merci pour ta réponse
Tous d’abord je tiens à te dire bravo et merci pour ton travail et ton explication sue ce fil de discussion.
Dans le fil de la discussion tu autorise l’utilisation et la distribution du fichier en citant l’auteur. Je n’et jamais eu l’attention de dire que ces mes fichiers et j’ai bien cité l’auteur de ce travail (qui me semble être logique et normal) De plus dans la version originale du fichier il est indiqué l’auteur et la provenance, mais au regret de te rappelais que toute personne qui veut utiliser ce module peut également supprimer une partie.

'******************************** 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 *
' '**************************************************************************

Dans le fil de la discussion :

28/07/2016, 01h25
re oui y a pas de soucis distribue (en citant l'auteur et pourquoi pas le lien afin d'avoir le plus de retours possible pour d'éventuelles améliorations
tiens j'ai corrigé plein de petite chose tout du moins j'ai mis au prorata plutôt qu'utiliser des nombre y compris pour les font size

Tu dis dans t’a réponse « surtout que je crois te l'avoir dit il n'est nullement nécessaire de doubler les modules classe quelques motif dans le premier et c'était bon » Désoler de te contredire mais je n’ai pas eu cette chance d’avoir une réponse de quiconque (MP mail ou fil de la discussion)
Ce qui est dommage, je croyais peut-être à tort que le but d’un forum été l’entraide et le plaisir de discuté ce qui et pour moi être une passion.

Enlever les fichiers serait dommage.
Sauf si une solution de ta part avec des explication comme tu as l’habitude de donner dans le fil de discussion sont fait proprement.
Non je ne cherche pas une autre solution pour prendre ton travail, c’est juste pour aider d’autre personne qui voudrais dans un userform utiliser 2 calendriers (t’a contribution) sans souci en comprendre son fonctionnement.
Je tiens à m’excuse des propos qui ont pu te blaiser, ce n’été pas le but

Amicalement

**patricktoulon** · 15/01/2017, 13h33

re

Enlever les fichiers serait dommage.
Sauf si une solution de ta part avec des explication comme tu as l’habitude de donner dans le fil de discussion sont fait proprement.
Non je ne cherche pas une autre solution pour prendre ton travail, c’est juste pour aider d’autre personne qui voudrais dans un userform utiliser 2 calendriers (t’a contribution) sans souci en comprendre son fonctionnement.
Je tiens à m’excuse des propos qui ont pu te blaiser, ce n’été pas le but

si tu distribue mon module classe (mon code) tu dois laisser les caractéristique de l'auteur et surtout le laisser tel quel

bon il semblerait que ma réponse en MP ne te soit pas parvenu ou pas parti
en tout cas tu comprends bien que mettre 3 fichier : le prochain qui passe chercher une solution ne s'y retrouvera pas il n'est donc pas nécessaire de les laisser

et surtout il est hors de question que je réponde a a une future demande concernant un soucis sur mon code modifié par autrui tu le comprends bien

et surtout !!!car voila ce que je voulais dire quand je disais il n'est pas nécessaire de multiplier modules classe ce qui est complètement absurde celui qui t'a fait ca ne c'est pas trop

casser la tète et en terme de principe t'induit même en erreur

voici le même module classe légèrement modifié pour jusqu'à 50 textbox avec la même classe

il te suffit de mettre "cal" dans le tag des textboxs que tu veux qu'il soit des calendriers

code a mettre dans le userform et c'est tout !!!!

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

maintenant le module classe modifié colle ca dans un module classe appelle ce module classe "calendrier2"

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
 
'       '******************************** 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 plusieurs textboxs  dynamiquement avec la même 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
 
Function NB_JOURS(mois, année)
    NB_JOURS = Day(DateSerial(année, mois + 1, 1) - 1)
End Function
Function createcalendrier(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 listm = fram.Add("Forms.combobox.1", "listemois")
    With listm
        .ListRows = 12: .Font.Size = 9: .TextAlign = 1: .Move 0, 0, fram.Width / 3, 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), 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
            With tcal(T): Set .calendart = ctrl: 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()
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)
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 >= .Width, calendart.Left, Wi - (frame.Width + 20))
.Top = IIf(HT - calendart.Top >= .Height, calendart.Top, HT - (frame.Height + 20))
End With
End Sub

voila démo en image animée

Nom : demo2.gif
Affichages : 535
Taille : 369,3 Ko

voila maintenant enlève tes fichiers tous!!!!

et la prochaine fois avant de dire certaine chose réfléchi les participants de ce forum sont bénévoles et ne sont a la disposition de personne

Bonne lecture

**wappymil** · 16/01/2017, 11h14

Bonjour Patrick, pour commencer merci pour ta nouvelle version, grâce a elle j'ai résolu en grande partie mon soucis de calendrier dans mon module de gestion d’absence,
cela fonctionne génial, j'ai 25 textbox calendrier et c'est ok pour les 25.

crois tu qu'il serai possible facilement de forcé la date par défaut du calendrier en fonction de la date récupérée dans le textbox a l'ouverture (pour par exemple faire une modification ulterieur?

exemple

j'ai introduit dans le textbox a l'initialisation le 5 juin 2018 mais je veux la changé en 10 juin 2018 serait il possible que lors de l'ouverture du calendrier la date par défaut ne soit pas la date du jour mais le 5 juin 2018 ce qui permettrai de faire des click en moins et ce qui permettrait de déjà définir aussi une période de date (ex congé de fin d'année - commence en décembre de l'année en cours et se termine en janvier de l'année suivante)

mais ne t’inquiète pas pour cela, c'est au cas ou.

encore merci pour ce super outils que tu mets a notre disposition

charles

**patricktoulon** · 16/01/2017, 20h34

re
Bonjour
je pense que oui les textboxs se gèrent tout seul par la sous classe "calendart" dans la classe et donc on a un évènement substituant l'évènement mousedown dans la classe
par calendart le textbox est identifié alors comme tout ce passe dans cet évènement il serait pas impossible d'aller choper la fonction mise a jour avec des argument date l'or du visible true de la frame

j'entend parler par la que si il y a déjà une date dans le textbox l'ors du clik droit le calendrier prenne le mois et l'année du textbox ca c'est sur de sur possible oui

j'ai tout dis
je te laisse un peu chercher avant de ré intervenir car la on est dans une adaptation personnelle aux mieux comme pour casefayere je sortirais un hors série de la classe qui ne correspondra qu'a ce que tu demande

mais montre moi que tu bosse un peu et essaie de comprendre comment on pourrait faire je t'aiderais volontiers si ton travail sur ce point est démontré

**patricktoulon** · 16/01/2017, 21h10

re
@wappymil je confirme la modif est simple en deux secondes
j'attend les résultat de tes recherches

**wappymil** · 17/01/2017, 10h23

merci patrick
je vais m'y mettre je pense avoir une idée,
mais comme je fais cela a mes moments un peu perdu loll, j'ai parfois du mal a m'y tenir mais je pense que tu connais cela.

par contre j'ai un autre soucis qui lui aussi a mon avis doit être une subtilité, mais

lors que je lance mon module avec le bouton "modifier planning"

Nom : Capture1.PNG
Affichages : 468
Taille : 28,5 Ko

que je vais te joindre sur mon ordi c'est niquel, mais quant je le lance sur une autre il me met
les message suivant

Nom : Capture2.PNG
Affichages : 477
Taille : 60,8 Ko

Nom : Capture3.PNG
Affichages : 445
Taille : 60,1 Ko

Nom : Capture4.PNG
Affichages : 445
Taille : 34,7 Ko

tableau pening 5.1.xlsm

remarque
même Windows et même office

comme ce fichier est prévu a terme de fonctionner sur n'importe quel ordi et cela sans manipulation du USER.

je pense que je dois inclure un éléments a mon fichier mais je ne sais pas le quel.

je commence en VBA , et j’apprends au fur et a mesure et grâce a des personnes comme toi.
encore merci

voila et maintenant
je me lance a la recherche du point précédent. lollll

**patricktoulon** · 17/01/2017, 13h43

re
bonjour ben oui c'est évident qu'il te manque quelque chose regarde dans tes références il y a 2 manquants mais ca n'a rien a voir avec ma classe
et puis ton fichier chez moi a planter des l'ouverture j'ai donc dezipé le fichier pour voir ce qu'il en est et en effet il manque des fichiers dans "res."
il est donc corrompu et la y a rien a faire il faut que tu recopie les sheets et module dans un fichier tout neuf malheureusement avec les xlm c'est souvent le cas quand on copie et recopie les fichiers ou change d'emplacement dans les dossiers
il te manque la ref ref edit control et Microsoft Wondow common control v(6.0)mais je le répète ca n'a rien a voir avec ma classe
ma classe utilise du simple VBA et des control label combobox et frame

regarde bien dans tes références !!

**patricktoulon** · 17/01/2017, 14h05

regarde bien les dates dans les textbox et les postions du calandrier a l'affichage

Nom : demo2.gif
Affichages : 642
Taille : 375,5 Ko

**wappymil** · 17/01/2017, 14h16

non non je me doutait bien que cela n'avais rien a voir avec ton module....
mais quelque chose m’échappait

ok pas évident tout cela.

mais je suis contant je sais d'ou cela vient il ne me reste plus .K........... loll

encore merci

**wappymil** · 17/01/2017, 14h23

Envoyé par patricktoulon

regarde bien les dates dans les textbox et les postions du calandrier a l'affichage

genial voila ce qu'il me faut mais en premier recréer un fichier propre. grrrrrrrrrrrrrrrrrrr

**patricktoulon** · 17/01/2017, 14h27

une version hors séries spécialement pour toi

code userform toujours pareil

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 "calendrier2"

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
 
'       '******************************** 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
            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)
    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)
    If IsDate(calendart) Then
        listeM.ListIndex = Month(calendart) - 1
        listeA.Value = Year(calendart)
    Else
        listeM.ListIndex = Month(Date) - 1
        listeA.Value = Year(Date)
    End If
    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
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 ca fera ce que tu veux

fait la différence entre l'ancienne version et ca t'aidera a comprendre ce que j'ai ajouté

Attention la position calendrier dans le temps fonctionne que si les dates dans les textboxs sont au format "dd/mm/yyyy" je pourrais pousser plus loin mais ca serait te macher le travail hein

comme tel ca fait exactement ce que tu demande

**wappymil** · 17/01/2017, 14h47

je te fais la promesse que je vais étudier cela de très prêt. mille x merci et des que j'ai terminer de mettre cela en ordre je te fais parvenir le fichier.
pour que tu me donne ton avis. si tu es d'accord bien sur.
bien a toi
et je ne manquerais pas de faire ta pub en Belgique du coté de Bastogne
si tu passe par la tu es le bien venu.

**Philippe Tulliez** · 17/01/2017, 15h53

Bonjour Patrick,
Très beau travail que je viens de tester

.
Un petit bogue lorsque l'on clique sur un carré où il n'y a pas de date. Le clic est accepté et renvoie une date tronquée (/mm/aaaa) je pense que ce serait bien que le clic ne soit pas accepté.
Lorsque le Textbox a déjà une date (par exemple le 2/2/2016) le calendrier proposé est celui de la dernière sélection. Il me semble que proposer le calendrier de la date contenue dans le textbox serait préférable avec la possibilité par exemple de cliquer sur un bouton pour obtenir l'affichage du mois en cours.

**patricktoulon** · 17/01/2017, 16h28

re
Bonjour Philippe je crois que tu dois avoir testé une version intermédiaire

la derniere version spéciale pour wappymil+ elle fait tout ca

la gestion du click dans une cel vide du calendrier ne fait rien et ferme le calendrier

et a l'ouverture par clik droit sur textbox le calendrier est positionné sur le mois et l'année de la date déjà inscrite dans le textbox

attention !! cette fonction de positionnement dans le temps du calendrier par rapport a la date déjà inscrite dans le textbox ne fonctionne qu'avec les formats "dd/mm/yyyy"

et le move de l'usf rend invisible le calendrier comme un popup (même comportement)

prend la dernière version pour wappymill+

a moins que je n'ai pas compris ta remarque ou que je n'ai pas mis cette gestion pour wappymill

regarde bien le comportement du calendrier

Nom : demo2.gif
Affichages : 562
Taille : 384,3 Ko

**Philippe Tulliez** · 17/01/2017, 18h17

Bonjour Patrick,

je crois que tu dois avoir testé une version intermédiaire la derniere version spéciale pour wappymil+ elle fait tout ca

J'ai bien pris la dernière version publiée aujourd'hui à 14h27. L'info-bulle n'affiche effectivement rien sur les boutons sans date mais permet le clic de la souris et retourne une date (chaîne de caractères) sans le jour.

et a l'ouverture par clik droit sur textbox le calendrier est positionné sur le mois et l'année de la date déjà inscrite dans le textbox

L'affichage reste sur la dernière sélection

attention !! cette fonction de positionnement dans le temps du calendrier par rapport a la date déjà inscrite dans le textbox ne fonctionne qu'avec les formats "dd/mm/yyyy"

C'est bien le cas

**patricktoulon** · 17/01/2017, 21h07

re

@Philippe c'est assez étonnant ce que tu me dis
voila l'évènement des boutons jour dans la classe et il y a bien la gestion des boutons vides et elle fonctionne
maintenant si tu veux que ca fasse vraiment rien il faut enlever le frame.visible false et ne garder que le exit sub
comme ca tant que la souris n'est pas sorti du calendrier ou un jour valides ai été tapé le calendrier reste affiché
ca fait parti après des préférences de chacun

Code :

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

1
2
3
4
5
6
7
8
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)
    frame.Visible = False
    listeF.ListIndex = 0
End Sub

et la date n'est pas la dernière quand on clik droit sur les textbox c'est soit le mois et l'année de "Date" ou le mois et l'année qui est dans le textbox

j'avoue que je comprends pas pourquoi ca réagi comme chez toi

Un calendar pour tous ( control calendrier ) [Toutes versions]

Macros et VBA Excel

Discussions similaires

Partager

Partager