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
| Sub test()
MsgBox calendrier_Dynamique
End Sub
Function calendrier_Dynamique() As Variant
Dim Obj As Object
Dim j As Integer
Set USF = ThisWorkbook.VBProject.VBComponents.Add(3)
With USF: .Properties("Caption") = "Mon calendrier": .Properties("Width") = 135: .Properties("Height") = 150: End With
Set Obj = USF.Designer.Controls.Add("MSComCtl2.DTPicker.2")
With Obj: .Left = 0: .Top = 0: .Width = 130: .Height = 20: .Name = "calendrier": .CalendarBackColor = &HC0FFC0: End With
With USF.CodeModule
j = .CountOfLines
.insertlines j + 1, "public madate as string"
.insertlines j + 2, "Private Sub calendrier_Change()"
'Option pour refermer l'userform après le choix de la date.
.insertlines j + 3, " madate=calendrier.value:me.hide"
.insertlines j + 4, "End Sub"
.insertlines j + 5, "Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)"
.insertlines j + 6, "Cancel=true:madate=false: Me.Hide "
.insertlines j + 7, "End Sub"
End With
VBA.UserForms.Add (USF.Name)
With UserForms(UserForms.Count - 1)
.Show
calendrier_Dynamique = .madate
End With
ThisWorkbook.VBProject.VBComponents.Remove (USF)
End Function |
