Suggestions |
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 |
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 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")
End SubIf .FindControl(1, , "Datepicker") Is Nothing Then
End WithWith .Controls.Add(1, , "Datepicker", , True)
End If.Tag = "Datepicker"
End With.Caption = "DatePicker" .OnAction = "Z_Sheet1.M_snb" Private Sub Workbook_BeforeClose(Cancel As Boolean)
With Application.CommandBars("Cell")
End SubIf Not .FindControl(1, , "Datepicker") Is Nothing Then .Controls("Datepicker").Delete
End WithAll 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. 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. Userform: UF_01The 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)
End SubFor j = 0 To UBound(titels) If j < 7 Then Me("L_5" & j).Caption = Left(Format(j + 2, "ddd"), 1)
NextSet titels(j).v_titel = Me("L_" & Format(j, "00")) s_month_Change to position the Userform next to the active/selected cell
Private Sub UserForm_Activate()
Top = ActiveCell.Top + 72
End SubLeft = ActiveCell.Offset(, 1).Left + 12 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)
End SubL_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)
NextWith titels(j).v_titel Y = X - Weekday(X, 2) + Val(Right(.Name, 2))+1
End With.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
End If.BackStyle = 1 Classmodule: C_calThe 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
End SubSet UF = .Parent.Parent.Parent
End WithIf UF.Tag <> "" Then UF.Controls(UF.Tag).BackStyle = 0 If .BackColor <> vbRed And .Font.Size = 8 Then .BackStyle = 1
End IfUF.Tag = .Name writing the selected date in the DatePicker into the active/selected cell
Private Sub v_titel_Click()
With v_titel
End SubSet UF = .Parent.Parent.Parent
End Withd00 = DateSerial(Year(Date), Month(Date) + UF.s_month.Value, .Caption) Select Case UF.Name Case "UF_01" ActiveCell = d00
Case "UF_02"UF.Hide UF.Controls(UF.F_01.Tag).Caption = d00
End SelectUF.F_01.Visible = False 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 SubThe 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
End Sub.Top = it.Top - 30
End With.Left = it.Left + it.Width + 12 .Tag = it.Name .Visible = True 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 Excel .xlsb File: DatePicker.xlsbThis 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.xlamThe AddIn file can be saved in the special Excel AddIn folder.You can find this folder using: MsgBox Application.UserLibraryPath 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.docmThe 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. |