Hello,
I tested the following VBA-code (see below) in excel 2000 on Windows XP. And
it works
The code is used in a userform called CalendarUserForm (height 216 points,
width 170 points) with
two CommandButtons (OKButton, CancelButton) on the userform.On the userform,
the code creates
a month-calendar-control using the WIN-API.
I know i could use the Microsoft MonthView Control ActiveX-object in
MSCOMCT2.OCX.
But it is difficult to distribute and install these ocx-files on other
systems.
info about the month-calendar-object:
http://msdn.microsoft.com/library/de...l/monthcal.asp
I have a few questions about the code(see below):
1) Is this the correct way to create and use the month-calendar-control in
VBA?
Is it correct code in general? Any remarks, comments about it?
I know i could use the Microsoft MonthView Control ActiveX-object in
MSCOMCT2.OCX.
But it is difficult to distribute and install this ocx-files on other
systems.
2) The month-calendar-object sends notification messages (MCN_SELCHANGE,
MCN_SELECT, MCN_GETDAYSTATE) to the parent(the userform) when it receives
user input.
Currently, I ignore these messages. I do not process these messages. Should
i process these messages
or is it safe not to process them?
3) What about destroying the month-calendar-object in UserForm_Terminate()?
Is it correct to send a WM_CLOSE-message to the object before using the
DestroyWindow-call?
Or should I only perform the DestroyWindow-call ?
4) I use InitCommonControlsEx(). (A WIN-API-function).It registers the
common control classes.
Is it safe the call this function several times, because it is called
everytime ShowResult is called.
Is there an opposite function which unregisters the common classes?
Something like
UnInitCommonControlsEx
thanks,
Johan
----------
the code from CalendarUserForm.frm
----------
Option Explicit
' private variables
Private cal_result As VbMsgBoxResult ' return-value of ShowResult
Private cal_selected_date As Date ' current selected-date
Private cal_control_handle As Long 'handle to month-calendar-control
' const month-calendar-control
Private Const MCM_GETCURSEL As Long = &H1001
Private Const MCM_SETCURSEL As Long = &H1002
Private Const MCM_SETTODAY As Long = &H100C
Private Const ICC_DATE_CLASSES As Long = &H100
Private Const MONTHCAL_CLASS As String = "SysMonthCal32"
' windows-message
Private Const WM_CLOSE As Long = &H10
' const style
Private Const WS_CHILD As Long = &H40000000
Private Const WS_VISIBLE As Long = &H10000000
Private Const WS_BORDER As Long = &H800000
Private Type INITCOMMONCONTROLSEX_TYPE
dwSize As Long
dwICC As Long
End Type
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 Declare Function MonthCal_GetCurSel Lib "user32" _
Alias "SendMessageA" _
(ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByRef lParam As SYSTEMTIME) As Long
Private Declare Function MonthCal_SetCurSel Lib "user32" _
Alias "SendMessageA" _
(ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByRef lParam As SYSTEMTIME) As Long
Private Declare Function InitCommonControlsEx Lib "comctl32" _
(ByRef lpInitCtrls As INITCOMMONCONTROLSEX_TYPE) As Long
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 FindWindowEx Lib "user32" _
Alias "FindWindowExA" _
(ByVal hwndParent As Long, _
ByVal hwndChildAfter As Long, _
ByVal lpszClass As String, _
ByVal lpszWindow 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 Function PostMessage Lib "user32" _
Alias "PostMessageA" _
(ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
' set cal_result and hide userform
Private Sub CancelButton_Click()
cal_result = vbCancel
Me.Hide
End Sub
' determine current selected date
' if it succeeds to determine, set cal_result to vbOk and hide the userform
Private Sub OKButton_Click()
On Error GoTo errorhandler
If cal_control_handle < 0& Then
Dim selected_system_time As SYSTEMTIME
If MonthCal_GetCurSel(cal_control_handle, MCM_GETCURSEL, 0&, _
selected_system_time) < 0 Then
' strip time-part of current selected date
With selected_system_time
.wHour = 0
.wMinute = 0
.wSecond = 0
End With
cal_selected_date = SystemTimeToDate(selected_system_time)
If CDbl(cal_selected_date) = 0 Then
cal_result = vbOK
Me.Hide
End If
End If
End If
Exit Sub
errorhandler:
cal_result = vbCancel
End Sub
' close month calendar control
' destroy month calendar control
Private Sub UserForm_Terminate()
On Error Resume Next
If cal_control_handle < 0& Then
SendMessage cal_control_handle, WM_CLOSE, 0&, ByVal 0&
DestroyWindow cal_control_handle
cal_control_handle = 0&
End If
End Sub
' event is fired when you use the upperright Close-button
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
On Error Resume Next
' prevent unload !
' just hide it
If CloseMode = vbFormControlMenu Then
cal_result = vbCancel
Cancel = 1
Me.Hide
End If
End Sub
' Shows userform after it created the month-calendar-control
' the function returns when the user clicks on the OK-button or
Cancel-button
' (SelectedDate is the date selected in the month calendar object)
Public Function ShowResult(ByRef SelectedDate As Date) As VbMsgBoxResult
On Error GoTo errorhandler
Err.Clear
' strip time-part of the selected date
SelectedDate = DateSerial(Year(SelectedDate), Month(SelectedDate),
Day(SelectedDate))
OKButton.Enabled = False
cal_result = vbCancel ' returned when you use the upperright
Close-button
cal_selected_date = SelectedDate
cal_control_handle = 0&
' determine handle to userform
Dim prevCaption As String
Me.Caption = CStr(Timer())
Dim userform_handle As Long
If Val(Application.Version) < 9 Then
userform_handle = FindWindow("ThunderXFrame", Me.Caption) 'XL97
Else
userform_handle = FindWindow("ThunderDFrame", Me.Caption) 'XL2000
End If
Me.Caption = prevCaption
If userform_handle < 0& Then
' determine handle to parent of month calendar control
' the parent is the first child of the userform
Dim parent_handle As Long
parent_handle = FindWindowEx(userform_handle, 0&, vbNullString,
vbNullString)
If parent_handle < 0& Then
Dim initCtrlsStruct As INITCOMMONCONTROLSEX_TYPE
initCtrlsStruct.dwICC = ICC_DATE_CLASSES
initCtrlsStruct.dwSize = Len(initCtrlsStruct)
If InitCommonControlsEx(initCtrlsStruct) < 0 Then
' create month calendar control
cal_control_handle = CreateWindowEx(0, MONTHCAL_CLASS,
vbNullString, _
WS_BORDER Or WS_CHILD Or WS_VISIBLE, 10, 10, 200, 200, _
parent_handle, 0&, 0&, ByVal 0&)
If cal_control_handle < 0 Then
OKButton.Enabled = True
End If
End If
End If
End If
' show the userform with the month-calendar-object
' wait untill form is hidden
Me.Show
ShowResult = cal_result
If ShowResult = vbOK Then
SelectedDate = cal_selected_date
End If
Unload Me
Exit Function
errorhandler:
ShowResult = vbCancel
Unload Me
End Function
Private Function SystemTimeToDate(ByRef system_time As SYSTEMTIME) As Date
With system_time
SystemTimeToDate = DateSerial(.wYear, .wMonth, .wDay) + _
TimeSerial(.wHour, .wMinute, .wSecond)
End With
End Function
Private Function DateToSystemTime(ByVal Date_Value As Date) As SYSTEMTIME
Dim system_time As SYSTEMTIME
With system_time
.wYear = Year(Date_Value)
.wMonth = Month(Date_Value)
.wDayOfWeek = Weekday(Date_Value, vbSunday) - 1
.wDay = Day(Date_Value)
.wHour = Hour(Date_Value)
.wMinute = Minute(Date_Value)
.wSecond = Second(Date_Value)
.wMilliseconds = 0
End With
DateToSystemTime = system_time
End Function
----------
An example of how the userform CalendarUserForm is called:
(SelectedDate is the date selected in the month calendar object)
Public Function ShowCalendar(ByRef SelectedDate As Date) As VbMsgBoxResult
On Error GoTo errorhandler
ShowCalendar = CalendarUserForm.ShowResult(SelectedDate)
Exit Function
errorhandler:
ShowCalendar = vbCancel
End Function
----------