Cette procédure est facilement intégrable à un évènement de la feuille de calcul ou à une barre d'outils personnelle: La date sélectionnée est automatiquement insérée dans la cellule active.
Vous devez disposer de l'ocx MSCOMCT2.ocx pour utiliser les contrôles MonthView et DataPicker.
Ce premier exemple utilise le contrôle Monthview:
Enlevez le commentaire sur cette ligne '.insertlines j + 3, " Unload Me"
pour que la fenêtre se referme automatiquement après l'insertion de la date.
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 Option Explicit Dim Usf As Object Sub LancementProcedure() Dim X As Object Dim NomMonthView As String NomMonthView = "MonthView1" 'Lance la procédure de création du userform et du contrôle MonthView Set X = UserForm_Et_MonthView_Dynamique(NomMonthView) 'Affichage userform X.Show 'Suppression du userform après la fermeture ThisWorkbook.VBProject.VBComponents.Remove Usf Set Usf = Nothing End Sub Function UserForm_Et_MonthView_Dynamique(NomObjet As String) As Object Dim Obj As Object Dim j As Integer 'Création UserForm Set Usf = ThisWorkbook.VBProject.VBComponents.Add(3) With Usf .Properties("Caption") = "Mon calendrier" .Properties("Width") = 135 .Properties("Height") = 140 End With 'Création du contrôle MonthView Set Obj = Usf.Designer.Controls.Add("MSComCtl2.MonthView.2") With Obj .Left = 0: .Top = 0: .Width = 150: .Height = 140 .Name = NomObjet .ForeColor = &HC000C0 .TitleBackColor = &HC000C0 End With 'Ajout de la procédure évènementielle DateClick du contrôle MonthView With Usf.CodeModule j = .CountOfLines .insertlines j + 1, "Sub " & NomObjet & "_DateClick(ByVal DateClicked As Date)" 'Insère la date dans la cellule active .insertlines j + 2, " ActiveCell = DateClicked" 'Option pour refermer l'userform après l'insertion de la date. '.insertlines j + 3, " Unload Me" .insertlines j + 4, "End Sub" End With VBA.UserForms.Add (Usf.Name) Set UserForm_Et_MonthView_Dynamique = UserForms(UserForms.Count - 1) End Function
Voici une deuxième procédure qui utilise le contrôle DataPicker:
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 Option Explicit Dim Usf As Object Sub LancementProcedure() Dim X As Object Dim NomdtPicker As String NomdtPicker = "DtPicker1" Set X = UserForm_Et_DataPicker_Dynamique(NomdtPicker) X.Show ThisWorkbook.VBProject.VBComponents.Remove Usf Set Usf = Nothing End Sub Function UserForm_Et_DataPicker_Dynamique(NomObjet As String) As Object Dim Obj As Object Dim j As Integer Set Usf = ThisWorkbook.VBProject.VBComponents.Add(3) With Usf .Properties("Caption") = "Mon calendrier" .Properties("Width") = 130 .Properties("Height") = 40 End With Set Obj = Usf.Designer.Controls.Add("MSComCtl2.DTPicker.2") With Obj .Left = 0: .Top = 0: .Width = 130: .Height = 20 .Name = NomObjet .CalendarBackColor = &HFF00FF End With With Usf.CodeModule j = .CountOfLines .insertlines j + 1, "Sub " & NomObjet & "_Change()" .insertlines j + 2, " ActiveCell.Value = Format(DateSerial(Year(" _ & NomObjet & "), Month(" & NomObjet & "), Day(" _ & NomObjet & ")), " & Chr(34) & "dd mmmm yyyy" & Chr(34) & ")" 'Option pour refermer l'userform après l'insertion de la date. '.insertlines j + 3, " Unload Me" .insertlines j + 4, "End Sub" End With VBA.UserForms.Add (Usf.Name) Set UserForm_Et_DataPicker_Dynamique = UserForms(UserForms.Count - 1) End Function
Partager