Hello,

I tested the following VBA-code (see below) in excel 2000 on Windows XP. And it works.

The code(see below) 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-control:
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

' -------------------------------------------------------------------------------------

' 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

' 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

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