DatePicker

xlsb file
AddIn file
Word file
     DatePicker

1   Date in Excel worksheet

1.1   'cell'menu option
1.2   Datepicker: process
1.3   DatePicker: elements

2   Date in Userform

2.1   DatePicker and controls
2.2   Datepicker: process
2.3   Datepicker: elements

3   Sample files

DatePicker

MS has removed the VBA 'DatePicker'.
A lot of people do pity that.

I will present an alternative for 2 cases:
- input a date in an Excel worksheet
- input a date in a 'field' in a VBA-Userform

1. Date in Excel worksheet

1.1 Option in 'cell' menu

At the opening of the file the code will add an option in the cell's rightclickmenu.
Its name is: DatePicker.
Private Sub Workbook_Open()
With Application.CommandBars("Cell")
If .FindControl(1, , "Datepicker") Is Nothing Then
With .Controls.Add(1, , "Datepicker", , True)
.Tag = "Datepicker"
.Caption = "DatePicker"
.OnAction = "Z_Sheet1.M_snb"
End With
End If
End With
End Sub
You can remove this option when closing the file:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
With Application.CommandBars("Cell")
If Not .FindControl(1, , "Datepicker") Is Nothing Then .Controls("Datepicker").Delete
End With
End Sub
If you don not remove this option it will be available as long as Excel is open.
All other Excel files can use this option even though the file containing the DatePicker code is closed.
Only when Excel is being closed the option automatically disappears.

1.2 Datepicker: process

A spinbutton in the Datepicker allows you to select a certain month prior to or after the present one.
At the start the DatePicker shows the present month.
In the heading the year and monthname are visible.
The Datepicker shows 6 weeks, containing the selected month.
Today's date is marked red.
The first column shows the ISO-weeknumbers.
The selection of dates is restricted to the dates in the chosen month: these dates are marked by a larger and bold font.
And only these dates are marked blue when hovering over. This indicates exactly which date is 'active'.
Select the date by rightclicking. The date value will be transferred into the active/selected cell.

1.3 Datepicker: elements

Userform: UF_01

The Datepicker is part of the Userform 'UF_01'.
The Userform contains:
- frame F_01 : all DatePicker controls
- frame F_02 : all 30 weekday labels
- frame F_03 : all 12 weekend days labels
- 6 labels for ISO weeknumbers: w_0 .. w_6
- 7 labels for the first character of weekdaynames: L_50 .. L_56
- 1 label for year and monthname: L_60
- 1 spinbutton to scroll by month: S_month

Userform code

The Userform contains 3 macros:
- Initialize:
to link Userform elements to the classmodule C_cal
Dim titels() As New C_cal

Private Sub UserForm_Initialize()
ReDim titels(41)

For j = 0 To UBound(titels)
If j < 7 Then Me("L_5" & j).Caption = Left(Format(j + 2, "ddd"), 1)

Set titels(j).v_titel = Me("L_" & Format(j, "00"))
Next

s_month_Change
End Sub
- Activate:
to position the Userform next to the active/selected cell
Private Sub UserForm_Activate()
Top = ActiveCell.Top + 72
Left = ActiveCell.Offset(, 1).Left + 12
End Sub
- S_month_Change:
to show the data of the selected month
* representation of year and monthname
* ISO weeknumber
* data in previous month
* data in following month
* ISO weekdays in the selected month
* ISO weekend days in the selected month
* marking today
Sub s_month_Change()
X = DateSerial(Year(Date), Month(Date) + s_month.Value, 1)
L_60.Caption = Format(X, " yyyy" & vbTab & Space(6) & "mmmm")

For j = 0 To UBound(titels)
If j < 6 Then Me("w_" & j).Caption = DatePart("ww", X + 7 * j - Weekday(X + 7 * j, 2) + 4, 2, 2)

With titels(j).v_titel
Y = X - Weekday(X, 2) + Val(Right(.Name, 2))+1
.Caption = Day(Y)
.Enabled = Month(X) = Month(Y)
.Font.Size = 7 - .Enabled
.Font.Bold = .Enabled
.BackStyle = 0
.BackColor = vbCyan
If Format(Y, "yyyymmdd") = Format(Date, "yyyymmdd") Then
.BackColor = vbRed
.BackStyle = 1
End If
End With
Next
End Sub

Classmodule: C_cal

The classmodule contains 2 macros:

- MouseMove
highlighting a date when hovering over.
The name of the control will be temporarily stored in the Tag property of the Userform.
Private Sub v_titel_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
With v_titel
Set UF = .Parent.Parent.Parent
If UF.Tag <> "" Then UF.Controls(UF.Tag).BackStyle = 0

If .BackColor <> vbRed And .Font.Size = 8 Then
.BackStyle = 1
UF.Tag = .Name
End If
End With
End Sub
- Click
writing the selected date in the DatePicker into the active/selected cell
Private Sub v_titel_Click()
With v_titel
Set UF = .Parent.Parent.Parent
d00 = DateSerial(Year(Date), Month(Date) + UF.s_month.Value, .Caption)
End With

Select Case UF.Name
Case "UF_01"
ActiveCell = d00
UF.Hide
Case "UF_02"
UF.Controls(UF.F_01.Tag).Caption = d00
UF.F_01.Visible = False
End Select
End Sub

2. Date in Userform

2.1 DatePicker and controls

The Userform 'UF_02' illustrates a DatePicker/calendar in a Userform.
Userform 'UF_02' will be shown by clicking the ActiveX button in Sheet1.
The DatePicker is in the invisible Frame 'F_01'.
This frame becomes visible as soon as the user clicks a control that needs a date input.
The sample file has 2 inpu controls: 1 for arrival date and 1 for a departure date.
The amount of controls in a Userform that can use the Datepicker is unlimited.
The 'Click' eventcode of a control unveils Frame 'F_01' and the DatePicker
Private Sub L_90_Click()
M_date L_90
End Sub
This eventcode calls a common macro 'M_date' and passes the name of the control as argument to the macro.

The macro M_date:
- makes the Frame 'F_01' visible
- positions the Frame 'F_01' to the calling control

Sub M_date(it)
With F_01
.Top = it.Top - 30
.Left = it.Left + it.Width + 12
.Tag = it.Name
.Visible = True
End With
End Sub

2.2 DatePicker: process

See the description 1.2 DatePicker: process

2.3 DatePicker: elements

There are 2 differences to the elements in Userform 'UF_01':

Userform 'UF_02' lacks an eventprocedure 'Activate'.
In Userform 'UF_02' the position of the Userform isn't important, the position of Frame 'F_01' in relation to the calling control is decisive.

The '_Click' macro in the classmodule is adapted since the result of the Datepicker will have to be written into the calling control.
At Case "F_02" is how the calling control has to be filled.
Case "UF_02"
UF.Controls(UF.F_01.Tag).Caption = d00
UF.F_01.Visible = False
See further: 1.3 Datepicker: elements


3. Sample files

Excel .xlsb File: DatePicker.xlsb

This file contains all the code and functionalities described above.
An .xlsb file is more compact than an .xlsm file, but identical in its functioning.
When opened the DatePicker is available in each worksheet and as Userform.

Excel AddIn .xlam file: DatePicker.xlam

The AddIn file can be saved in the special Excel AddIn folder.
You can find this folder using:
MsgBox Application.UserLibraryPath
In the Tab 'Developer' in the option 'AddIn' you can install the AddIn by checkBox.
Excel now loads this AddIn every time Excel will be opened.
The DatePicker options will then be available in all open Excel files.

Word file: DatePicker.docm

The file makes use of the same DatePicker code as in the Excel files.
Only the version to use the DatePicker in a Userform is present.
Start the Userform by clicking the button in the table.
The results of the DatePicker will be transferred to the Word document by documentvariables.