How can I create a calendar input in VBA Excel?

Problem Statement

In VBA, three main kinds of date time controls can be used provided certain ocxs have been registered using administrator rights. These are VB6 controls and are not native to VBA environment. To install the Montview Control and Datetime Picker, we need to set a reference to Microsoft MonthView Control 6.0 (SP4) which can only be accessed by elevated registration of mscomct2.ocx. Similarly for mscal.ocx and mscomctl.ocx. Having said that, the deprecated mscal.ocx may or may not work on Windows 10.

Depending on your Windows and Office versions (32 bit or 64 bit), it can be really painful to register these ocxs.

The Monthview Control, Datetime Picker and the deprecated Calendar control look like below.

So what problem can I face if I include these in my applicaiton?

If you include them in your project and distribute them to your friends, neighbours, clients etc the application may or may not work depending on whether they have those ocx installed.

And hence it is highly advisable NOT to use them in your project

What alternative(s) do I have?

This calendar, using Userform and Worksheet, was suggested earlier and is incredibly basic.

When I saw the Windows 10 calendar which popped up when I clicked on the date and time from the system tray, I could not help but wonder if we can replicate that in VBA.

This post is about how to create a calendar widget which is not dependant on any ocx or 32bit/64bit and can be freely distributed with your project.

This is what the calendar looks like in Windows 10:

and this is how you interact with it:


The sample file (added at the end of the post) has a Userform, Module and a Class Module. To incorporate this into your project, simply export the Userform, Module and the Class Module from the sample file and import it into your project.

Class Module Code

In the Class Module (Let's call it CalendarClass) paste this code

Public WithEvents CommandButtonEvents As MSForms.CommandButton

'~~> Unload the form when the user presses Escape
Private Sub CommandButtonEvents_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    If Not f Is Nothing Then If KeyAscii = 27 Then Unload f
End Sub

'~~> This section delas with showing/displaying controls
'~~> and updating different labels
Private Sub CommandButtonEvents_Click()
    f.Label6.Caption = CommandButtonEvents.Tag

    If Left(CommandButtonEvents.Name, 1) = "Y" Then
        If Len(Trim(CommandButtonEvents.Caption)) <> 0 Then
            CurYear = Val(CommandButtonEvents.Caption)                
            With f
                .HideAllControls
                .ShowMonthControls

                .Label4.Caption = CurYear
                .Label5.Caption = 2

                .CommandButton1.Visible = False
                .CommandButton2.Visible = False
            End With
        End If
    ElseIf Left(CommandButtonEvents.Name, 1) = "M" Then
        Select Case UCase(CommandButtonEvents.Caption)
            Case "JAN": CurMonth = 1
            Case "FEB": CurMonth = 2
            Case "MAR": CurMonth = 3
            Case "APR": CurMonth = 4
            Case "MAY": CurMonth = 5
            Case "JUN": CurMonth = 6
            Case "JUL": CurMonth = 7
            Case "AUG": CurMonth = 8
            Case "SEP": CurMonth = 9
            Case "OCT": CurMonth = 10
            Case "NOV": CurMonth = 11
            Case "DEC": CurMonth = 12
        End Select

        f.HideAllControls
        f.ShowSpecificMonth
    End If
End Sub

Module Code

In the Module (Let's call it CalendarModule) paste this code

Option Explicit

Public Const GWL_STYLE = -16
Public Const WS_CAPTION = &HC00000

#If VBA7 Then
    #If Win64 Then
        Public Declare PtrSafe Function GetWindowLongPtr Lib "user32" Alias _
        "GetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr

        Public Declare PtrSafe Function SetWindowLongPtr Lib "user32" Alias _
        "SetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, _
        ByVal dwNewLong As LongPtr) As LongPtr
    #Else
        Public Declare PtrSafe Function GetWindowLongPtr Lib "user32" Alias _
        "GetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr

        Private Declare Function SetWindowLongPtr Lib "user32" Alias _
        "SetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, _
        ByVal dwNewLong As LongPtr) As LongPtr
    #End If

    Public Declare PtrSafe Function DrawMenuBar Lib "user32" _
    (ByVal hwnd As LongPtr) As LongPtr

    Private Declare PtrSafe Function FindWindow Lib "user32" Alias _
    "FindWindowA" (ByVal lpClassName As String, _
    ByVal lpWindowName As String) As LongPtr

    Private Declare PtrSafe Function SetTimer Lib "user32" _
    (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, _
    ByVal uElapse As LongPtr, ByVal lpTimerFunc As LongPtr) As LongPtr

    Public Declare PtrSafe Function KillTimer Lib "user32" _
    (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As LongPtr

    Public TimerID As LongPtr

    Dim lngWindow As LongPtr, lFrmHdl As LongPtr
#Else

    Public Declare Function GetWindowLong _
    Lib "user32" Alias "GetWindowLongA" ( _
    ByVal hwnd As Long, ByVal nIndex As Long) As Long

    Public Declare Function SetWindowLong _
    Lib "user32" Alias "SetWindowLongA" ( _
    ByVal hwnd As Long, ByVal nIndex As Long, _
    ByVal dwNewLong As Long) As Long

    Public Declare Function DrawMenuBar _
    Lib "user32" (ByVal hwnd As Long) As Long

    Public Declare Function FindWindowA _
    Lib "user32" (ByVal lpClassName As String, _
    ByVal lpWindowName As String) As Long

    Public Declare Function SetTimer Lib "user32" ( _
    ByVal hwnd As Long, ByVal nIDEvent As Long, _
    ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long

    Public Declare Function KillTimer Lib "user32" ( _
    ByVal hwnd As Long, ByVal nIDEvent As Long) As Long

    Public TimerID As Long
    Dim lngWindow As Long, lFrmHdl As Long
#End If

Public TimerSeconds As Single, tim As Boolean
Public CurMonth As Integer, CurYear As Integer
Public frmYr As Integer, ToYr As Integer

Public f As frmCalendar

Enum CalendarThemes
    Venom = 0
    MartianRed = 1
    ArcticBlue = 2
    Greyscale = 3
End Enum

Sub Launch()
    Set f = frmCalendar

    With f
        .Caltheme = Greyscale
        .LongDateFormat = "dddd dd. mmmm yyyy" '"dddd mmmm dd, yyyy" etc
        .ShortDateFormat = "dd/mm/yyyy"  '"mm/dd/yyyy" or "d/m/y" etc
        .Show
    End With
End Sub

'~~> Hide the title bar of the userform
Sub HideTitleBar(frm As Object)
    #If VBA7 Then
        Dim lngWindow As LongPtr, lFrmHdl As LongPtr
        lFrmHdl = FindWindow(vbNullString, frm.Caption)
        lngWindow = GetWindowLongPtr(lFrmHdl, GWL_STYLE)
        lngWindow = lngWindow And (Not WS_CAPTION)
        Call SetWindowLongPtr(lFrmHdl, GWL_STYLE, lngWindow)
        Call DrawMenuBar(lFrmHdl)
    #Else
        Dim lngWindow As Long, lFrmHdl As Long
        lFrmHdl = FindWindow(vbNullString, frm.Caption)
        lngWindow = GetWindowLong(lFrmHdl, GWL_STYLE)
        lngWindow = lngWindow And (Not WS_CAPTION)
        Call SetWindowLong(lFrmHdl, GWL_STYLE, lngWindow)
        Call DrawMenuBar(lFrmHdl)
    #End If
End Sub

'~~> Start Timer
Sub StartTimer()
    '~~ Set the timer for 1 second
    TimerSeconds = 1
    TimerID = SetTimer(0&, 0&, TimerSeconds * 1000&, AddressOf TimerProc)
End Sub

'~~> End Timer
Sub EndTimer()
    On Error Resume Next
    KillTimer 0&, TimerID
End Sub

'~~> Update Time
#If VBA7 And Win64 Then ' 64 bit Excel under 64-bit windows  ' Use LongLong and LongPtr
    Public Sub TimerProc(ByVal hwnd As LongPtr, ByVal uMsg As LongLong, _
    ByVal nIDEvent As LongPtr, ByVal dwTimer As LongLong)
        frmCalendar.Label1.Caption = Split(Format(Time, "h:mm:ss AM/PM"))(0)
        frmCalendar.Label2.Caption = Split(Format(Time, "h:mm:ss AM/PM"))(1)
    End Sub
#ElseIf VBA7 Then ' 64 bit Excel in all environments
    Public Sub TimerProc(ByVal hwnd As LongPtr, ByVal uMsg As Long, _
    ByVal nIDEvent As LongPtr, ByVal dwTimer As Long)
        frmCalendar.Label1.Caption = Split(Format(Time, "h:mm:ss AM/PM"))(0)
        frmCalendar.Label2.Caption = Split(Format(Time, "h:mm:ss AM/PM"))(1)
    End Sub
#Else ' 32 bit Excel
    Public Sub TimerProc(ByVal hwnd As Long, ByVal uMsg As Long, _
    ByVal nIDEvent As Long, ByVal dwTimer As Long)
        frmCalendar.Label1.Caption = Split(Format(Time, "h:mm:ss AM/PM"))(0)
        frmCalendar.Label2.Caption = Split(Format(Time, "h:mm:ss AM/PM"))(1)
    End Sub
#End If

'~~> Improvement suggested by T.M (https://stackoverflow.com/users/6460297/t-m)
'(1) Get weekday name
Function wday(ByVal wd&, ByVal lang As String) As String
    ' Purpose: get weekday in "DDD" format
    wday = Application.Text(DateSerial(6, 1, wd), cPattern(lang) & "ddd")    ' the first day in year 1906 starts with a Sunday
End Function

'~~> Improvement suggested by T.M (https://stackoverflow.com/users/6460297/t-m)
'(2) Get month name
Function mon(ByVal mo&, ByVal lang As String) As String
    ' Example call: mon(12, "1031") or mon(12, "de")
    mon = Application.Text(DateSerial(6, mo, 1), cPattern(lang) & "mmm")
End Function

'~~> Improvement suggested by T.M (https://stackoverflow.com/users/6460297/t-m)
'(3) International patterns
Function cPattern(ByVal ctry As String) As String
    ' Purpose: return country code pattern for above functions mon() and wday()
    ' Codes: see https://msdn.microsoft.com/en-us/library/dd318693(VS.85).aspx
    ctry = LCase(Trim(ctry))
    Select Case ctry
        Case "1033", "en-us": cPattern = "[$-409]" ' English (US)
        Case "1031", "de": cPattern = "[$-C07]" ' German
        Case "1034", "es": cPattern = "[$-C0A]" ' Spanish
        Case "1036", "fr": cPattern = "[$-80C]" ' French
        Case "1040", "it": cPattern = "[$-410]" ' Italian
        ' more ...
    End Select
End Function

Userform Code

The Userform (Let's call it frmCalendar) code is too big to be posted here. Please refer to the sample file.

Screenshot

Themes

Highlights

  1. No need to register any dll/ocx.
  2. Easily distributable. It is FREE.
  3. No Administratior Rights required to use this.
  4. You can select a skin for the calendar widget. One can choose from 4 themes Venom, MartianRed, ArticBlue and GreyScale.
  5. Choose Language to see Month/Day name. Support for 4 languages.
  6. Specify Long and Short date formats

Sample File

Sample File

Acknowlegements @Pᴇʜ, @chrisneilsen and @T.M. for suggesting improvements.

What's New:

Bugs reported by @RobinAipperspach and @Jose fixed

How To Add A Date Picker Calendar in Excel VBA, It's a little old school looking, but actually has quite a nice feel to it. Start by creating a userform and enabling the control by Right-clicking on the� When I saw the Windows 10 calendar which popped up when I clicked on the date and time from the system tray, I could not help but wonder if we can replicate that in VBA. This post is about how to create a calendar widget which is not dependant on any ocx or 32bit/64bit and can be freely distributed with your project.


Get international day & month names

This answer is intended to be helpful to Sid's approach regarding internationalization; so it doesn't repeat the other code parts which I consider to be clear enough building a UserForm. If wanted, I can delete it after incorporation in Vers. 4.0.

Just in addition to Sid's valid solution I demonstrate a simplified code to get international weekday and month names - c.f. Dynamically display weekday names in native Excel language

Modified ChangeLanguage procedure in form's module frmCalendar

Sub ChangeLanguage(ByVal LCID As Long)
    Dim i&
    '~~> Week Day Name
     For i = 1 To 7
         Me.Controls("WD" & i).Caption = Left(wday(i, LCID), 2)
     Next i
    '~~> Month Name
     For i = 1 To 12
         Me.Controls("M" & i).Caption = Left(mon(i, LCID), 3)
     Next i
End Sub

Called Functions in CalendarModule

These three functions could replace the LanguageTranslations() function. Advantage: short code, less memory, easier maintenance, correct names

'(1) Get weekday name
Function wday(ByVal wd&, ByVal lang As String) As String
' Purpose: get weekday in "DDD" format
  wday = Application.Text(DateSerial(6, 1, wd), cPattern(lang) & "ddd")    ' the first day in year 1906 starts with a Sunday
End Function

'(2) Get month name
Function mon(ByVal mo&, ByVal lang As String) As String
' Example call: mon(12, "1031") or mon(12, "de")
  mon = Application.Text(DateSerial(6, mo, 1), cPattern(lang) & "mmm")
End Function

'(3) International patterns
Function cPattern(ByVal ctry As String) As String
' Purpose: return country code pattern for above functions mon() and wday()
' Codes: see https://msdn.microsoft.com/en-us/library/dd318693(VS.85).aspx
ctry = lcase(trim(ctry))
Select Case ctry
  Case "1033", "en-us"
    cPattern = "[$-409]" ' English (US)
  Case "1031", "de"
    cPattern = "[$-C07]" ' German
  Case "1034", "es"
    cPattern = "[$-C0A]" ' Spanish
  Case "1036", "fr"
    cPattern = "[$-80C]" ' French
  Case "1040", "it"
    cPattern = "[$-410]" ' Italian
' more ...
End Select
End Function

Use a Calendar control or Date Picker to fill in dates, How to Create a userform with a calendar or Date Picker control on it. TIP: I create an add-in for Windows and for the Mac, check out the Excel for Windows add-in here http://www.fontstuff.com/vba/vbatut07_2003.htm. A Pop-up Calendar for� Oftentimes, users want to click a button and select a date. This is no different for Excel developers. Check out this ActiveX control by Microsoft that allows users to do just that. It's a little old school looking, but actually has quite a nice feel to it. Oftentimes, users want to click a button and select a date. This is no different for Excel developers. Check out this ActiveX control by


Date Picker Control, I show you how to add a date picker (calendar) control to a our VBA if you could build that Duration: 5:14 Posted: Feb 13, 2018 Create a Calendar Press the button “Alt +F11” on the keyboard to open the worksheet. And then insert a new module in the Visual Basic editor. Now copying the following codes into the new module:


Excel VBA USERFORMS #25 Date Picker Calendar revealed! Loop , In this video you will learn how to create fully functional dynamic calendar in Excel VBA. We Duration: 18:34 Posted: Apr 28, 2019 On this page I show how to make a calendar and date picker on an Excel userform using VBA only and no ActiveX. This is how it looks in the Danish version of Excel 2003: In the U.S.A (English), where the first day of the week is Sunday and not Monday, the "day labels" from left to right will be SU, MO, TU, WE, TH, FR and SA, and February 1st


Fully Functional Dynamic Calendar Control in VBA (Part-1), This video explains, How to Add a date picker to an Excel worksheet. Time picker can be Duration: 6:26 Posted: Jul 22, 2019 Pop up a calendar when clicking a specific cell with VBA code. Please solve this problem as follows step by step. Note: This method can only work on Microsoft Excel 32-bit. Step 1: Create a UserForm with calendar. Please create a UserForm which contains the calendar you will pop up by clicking on a cell. 1.


How to Add Calendar to an Excel cell, Excel Calendar Control. How to create a live Calendar in Excel VBA with a UserForm. On the Insert menu, click Module. Copy the Visual Basic for Applications code below into the module sheet. On the File menu, click "Close and Return to Microsoft Excel." Click the Sheet1 tab. On the Tools menu, point to Macro, and then click Macros. Click CalendarMaker, and then click Run to create the calendar.