Tous l'intérêt de ce code est de découvrir une manière peux conventionnel pour inclure un contrôle sur une form….
Le code original est de Michel Pierron (
http://www.excelabo.net/trucs/ocx_optionnel) que j’ai simplifié et complété.
Source / Exemple :
'
' Source original : (Michel Pierron) http://www.excelabo.net/trucs/ocx_optionnel
'
' Pour tester, mettre dans en bas d’une form une TextBox nommé TextBox1, et deux boutons nommés CmdSET et CmdGET.
'
'
Option Explicit
Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hwndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function DestroyWindow Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Sub InitCommonControls Lib "comctl32" ()
' MonthCal Messages
Private Const MCM_FIRST = &H1000
Private Const MCM_GETCURSEL = (MCM_FIRST + 1)
Private Const MCM_SETCURSEL = (MCM_FIRST + 2)
Private Const MCM_SETCOLOR = (MCM_FIRST + 10)
Private Const MCM_GETCOLOR = (MCM_FIRST + 11)
Private Const MCM_SETFIRSTDAYOFWEEK = (MCM_FIRST + 15)
Private Const MCM_GETFIRSTDAYOFWEEK = (MCM_FIRST + 16)
' MonthCal Styles
Private Const MCS_MULTISELECT = &H2
Private Const MCS_WEEKNUMBERS = &H4
Private Const MCS_NOTODAYCIRCLE = &H8
Private Const MCS_NOTODAY = &H10
' MonthCal Color
Private Const MCSC_BACKGROUND = 0 ' the background color (between months)
Private Const MCSC_TEXT = 1 ' the dates
Private Const MCSC_TITLEBK = 2 ' background of the title
Private Const MCSC_TITLETEXT = 3
Private Const MCSC_MONTHBK = 4 ' background within the month cal
Private Const MCSC_TRAILINGTEXT = 5 ' the text color of header & trailing days
Private Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type
Private dtHwnd As Long
Private Sub Form_Load()
InitCommonControls
dtHwnd = CreateWindowEx(0, "SysMonthCal32", vbNullString, &H50000000 + MCS_WEEKNUMBERS, 40, 10, 200, 200, Me.hWnd, 0&, 0&, ByVal 0&)
SendMessage dtHwnd, MCM_SETCOLOR, MCSC_BACKGROUND, ByVal &HE0E0E0
SendMessage dtHwnd, MCM_SETCOLOR, MCSC_TITLEBK, ByVal RGB(46, 210, 50)
End Sub
Private Sub CmdGET_Click()
Dim CurSysTime As SYSTEMTIME
SendMessage dtHwnd, MCM_GETCURSEL, 0&, CurSysTime
Me.TextBox1.Text = Format(DateSerial(CurSysTime.wYear, CurSysTime.wMonth, CurSysTime.wDay), "Short Date")
End Sub
Private Sub CmdSET_Click()
Dim CurSysTime As SYSTEMTIME
On Error Resume Next
CurSysTime.wYear = Year(CDate(Me.TextBox1.Text))
CurSysTime.wMonth = Month(CDate(Me.TextBox1.Text))
CurSysTime.wDay = Day(CDate(Me.TextBox1.Text))
On Error GoTo 0
SendMessage dtHwnd, MCM_SETCURSEL, 0&, CurSysTime
End Sub
Private Sub Form_QueryClose(Cancel As Integer, CloseMode As Integer)
DestroyWindow dtHwnd
End Sub
Conclusion :
Pour la récupération automatique de la date sélectionnée, on pourrait prévoir une procédure de sous classement de la fenêtre dtHwnd. Personnellement, j'utilise un simple timer et la procédure suivante :
Private Sub TimerCalendar_Timer()
Static Dt As String
Dim CurSysTime As SYSTEMTIME
Dim NewDT As String
TimerCalendar = False
SendMessage dtHwnd, MCM_GETCURSEL, 0&, CurSysTime
NewDT = Format(DateSerial(CurSysTime.wYear, CurSysTime.wMonth, CurSysTime.wDay), "Short Date")
If Dt = "" Then Dt = NewDT
If Dt <> NewDT Then
Me.TextBox1.Text = NewDT
Dt = NewDT
End If
TimerCalendar = True
End Sub
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.