Adding Calendar To Form at Runtime Programatically

[mugginsjr]

thread707-1153323

I was searching for a solution to an "On the Fly" form problem when I found the above thread. Unfortunately the thread was closed and there was no answer. So I found the solution and came back to post it for anyone else who may be looking for the same answer.

The solution below allows the programmer to add a small button next to a date TextBox field on a userform. When the user clicks on that button, a calendar pop-up date picker is created on the fly and presented to the user, who then can select a date from it. The solution adds the selected date to the textbox and all the user had to do was point and click. No typing at all.

Please feel free to use the following code, but I ask that you please leave my name in it as creator. Have fun.......


I realize your message is a few years old, but I was searching for the same answer when I came across your question. I found the solution so I thought it best to come back here and post it for anyone else who might be interested.

The Calendar control is not part of the forms control collection, so using the following code will not work:

Set newCntrl = newForm.Designer.Add("forms.Calendar.1")

The Calendar control is part of the MSCAL collection, so to create it programmatically on a userform you would use the following code:

Set newCntrl = newForm.Designer.Add("MSCAL.Calendar.7")

This works in my 2007 version of Excel. I'm not sure if it will work in earlier versions of Excel. If not, go to a worksheet and record a macro. Insert a Calendar Control onto the worksheet, and you should see something similar to the following in the finished macro:

    ActiveSheet.OLEObjects.Add(ClassType:="MSCAL.Calendar.7", Link:=False, _
        DisplayAsIcon:=False, Left:=435.75, Top:=1598.25, Width:=215.25, _
        Height:=143.25).Select

Simply use whatever ClassType is listed there.

Here is the code I used in a userform CoedeModule with Date-TextBoxes. The code creates a calendar pop-up date picker programatically (on the fly) and allows the user to select a date from that calendar. That calendar assigns the chosen date to a global variable, which is then used by the On_Click procedure to assign the chosen date to a TextBox.

Two things you will need to do:
1. Declare the public variable NewDate in one of your standard - (non-form) code Modules, Module1, etc...

2. Create a small commandbutton on your main userform, (18 x 18) and give it the caption "..." Place the button right next to the textbox on your form that requires a date. In fact it should be just to the right of the textbox, actually touching the edge of the textbox so the user knows this is a button for a pop-up calendar. In the example below, this button is called CommanButton3.

In your standard Codemodule, CodeModule1 or whatever name you have given it, place the following declaration at the top of the module:

Public NewDate As Date

In the Main UserForm's CodeModule you want the pop-up calendar to appear when the user clicks on the small command-button next to the date text-box. So in the Main UserForm's CodeModule place the following code for that command-button On_Click Procedure:

Private Sub UserForm_Initialize()
   TextBox1.Value = "mm/dd/yy"
   ' you can add reference to MS Calendar Controls GUID here if needed
   ' The library must be referenced in your project for this to work.
   [...  Put whatever other initialization your form needs here ...] 
End Sub

Private Sub CommandButton1_Click() ' "Done" Button For Main UserForm
   [... Do whatever functions your form does ...]
   UnLoad Me
End Sub


Private Sub CommandButton2_Click() ' "Cancel" Button For Main UserForm
Unload Me
End Sub


Private Sub CommandButton3_Click() ' Calendar Pop-Up Button
   Run GetUserDate ' Runs the function below to crreate a calendar form
   [... User Selects a Date and execution returns here ...]
   TextBox1.Value = NewDate ' Add User's date to textbox from global variable
End Sub

Private Function GetUserDate()
Dim line As Long, newForm, newCntrl
'*******************************************
'   This Procedure Creates a Calendar Date Picker Popup,
'   displays it to the user, allows the user to select a date,
'   and then assigns that date to a global variable "NewDate",
'   which must be declared as Public in one of your main
'   Standard Code Modules.
'   The calling procedure can then use that global variable
'   as it needs to.
'
'   Created By John Richter 2011
'*******************************************

   ' You can add reference to MS Extensibility Controls GUID here if needed.
   ' The library must be referenced in your project for this to work.
    
    Application.VBE.MainWindow.Visible = False
    Set newForm = ThisWorkbook.VBProject.VBComponents.Add(3) ' add form
    
    newForm.properties("Caption") = "Choose a Date"
    newForm.properties("Height") = 245.25
    newForm.properties("Width") = 271
    
    Set newCntrl = newForm.Designer.Add("MSCAL.Calendar.7")
    
    With newCntrl
         .Name = "Calendar1"
         .Height = 144
         .Left = 24
         .Top = 18
         .Width = 216
    End With
    
    Set newCntrl = newForm.Designer.Add("forms.CommandButton.1")
    With newCntrl
         .Name = "CommandButton1"
         .Caption = "Cancel"
         .Left = 96
         .Top = 168
    End With
    
    Set newCntrl = newForm.Designer.Add("forms.Label.1")
    With newCntrl
         .Name = "Label1"
         .Caption = " (Click on GRAY dates to move forward or Backward)"
'         .Font.Size = 9.75
         .ForeColor = 8421504
         .Height = 18
         .Left = 18
         .Top = 234
    End With
     
    With newForm.CodeModule
           line = .CountOfLines
           .InsertLines line + 1, "Option Base 1"
           .InsertLines line + 2, "Public startMonthValue As String"
           .InsertLines line + 3, "Public startYearValue As String"
           .InsertLines line + 4, "Private Type POINTAPI"
           .InsertLines line + 5, "x As Long"
           .InsertLines line + 6, "y As Long"
           .InsertLines line + 7, "End Type"
           .InsertLines line + 8, "Private Declare Function GetCursorPos Lib " & """" & "user32" & """" & " _ "
           .InsertLines line + 9, "(lpPoint As POINTAPI) As Long"
           .InsertLines line + 10, "Dim pos As POINTAPI ' Declare variable"
           .InsertLines line + 11, "Private Sub Calendar1_Click()"
           .InsertLines line + 12, "    GetCursorPos pos ' Get Co-ordinates"
           .InsertLines line + 13, "    If pos.y < 367 Or pos.y > 497 Then Exit Sub"
           .InsertLines line + 14, "    If pos.x < 582 Or pos.x > 854 Then Exit Sub"
           .InsertLines line + 15, "    Dim MyNewDate As Date"
           .InsertLines line + 16, "    MyNewDate = Me.Calendar1.Value"
           .InsertLines line + 17, "    If Month(Me.Calendar1.Value) = startMonthValue And Year(Me.Calendar1.Value) = startYearValue Then"
           .InsertLines line + 18, "        NewDate = Calendar1.Value"
           .InsertLines line + 19, "        Unload Me"
           .InsertLines line + 20, "    Else"
           .InsertLines line + 21, "        Me.Calendar1.Value = MyNewDate"
           .InsertLines line + 22, "        startMonthValue = Month(MyNewDate)"
           .InsertLines line + 23, "        startYearValue = Year(MyNewDate)"
           .InsertLines line + 24, "    End If"
           .InsertLines line + 25, "End Sub"
           .InsertLines line + 26, "Private Sub CommandButton1_Click()"
           .InsertLines line + 27, "Unload Me"
           .InsertLines line + 28, "End Sub"
           .InsertLines line + 29, "Private Sub UserForm_Initialize()"
           .InsertLines line + 30, "Me.Calendar1.Value = Date"
           .InsertLines line + 31, "startMonthValue = Month(Date)"
           .InsertLines line + 32, "startYearValue = Year(Date)"
           .InsertLines line + 33, "End Sub"
    End With
    
    
    VBA.UserForms.Add(newForm.Name).Show
    ThisWorkbook.VBProject.VBComponents.Remove VBComponent:=newForm
'   The userform is deleted when done
End Function

Explanation: Mouse Position is used to prevent Calendar On_Click event from firing when the user has not selected a valid date box on the calendar form. IE, accidentally clicks on "Year" Label or "Day of Week" labels will not fire the event.

startMonthValue and startYearValue are used to prevent the On_Click procedure from firing when the user clicks on the preceding or tailing "Gray" date numbers on the calendar. This allows the user to change the calendar month by clicking on the gray dates, rather than having to use the drop down list. It's simply easier for the user.

I hope some of you will be able to use this in your own forms..... I only ask that you leave the reference to my name as creator in tact.

Enjoy......