Nifty Date Picker - Original
This Page is about the original “Nifty Date Picker” from Nifty Access – The NEW updated version of the “Nifty Date Picker” has some really cool extra features and can be found at this link here:- “Nifty Date Picker” – Updated
More Links in the DATE MENU Below!
There are some excellent date pickers available on the internet. So why should you chose the "Nifty Date Picker"?
First of all I've included details of my thought processes when I constructed it, including where I went wrong! This in itself will prove useful for anyone who wants to build stuff in MS Access.
It also gives you a very good handle on it, particularly if you want to modify this nifty date picker for your own particular use. I have also included a presentation, and a YouTube explaining how it works.
If that's not enough, then watch this space! This is just a beginning, I intend incorporating this "Nifty Date Picker" (Calendar Control) with my "Nifty Call Called" Class Module. The combination of the two will add some sophisticated functionality with benefit of ease of use.
With the class module added, you just need to call the Pop-Up calendar form "Nifty Date Picker" from any control and it will just work. It will take the caption from the Controls label and use that as the caption for the popup calendar form without you doing a thing! No coding!
Simulated After Update Event
By adding a simple piece of VBA code to your calling form, then the calendar form will be able to simulate the afterupdate event of the control it is associated with. This means if you have two dates, a person's date of birth, and today's date, then the code will automatically calculate the person's age without you having to press any other button. I haven't seen this functionality anywhere else.
Other benefits, the class module is a class! In essence it's a very simple class, plus I've done a playlist on YouTube here which runs through the functionality of the class module and also how to associate it with your own pop-up form.
Nifty Date Picker - Free!
Nifty Date Picker - For "ALL" Versions of MS Access
Video 1 (18:39)
In this YouTube video I demonstrate the Free “Nifty Date Picker” Suitable for “ALL” Versions of MS Access” I show you how to put together your own Nifty Date Picker Form.
Why? Well a lot of code examples are only available in the later versions of MS Access (accdb). This means Some examples won’t work in earlier versions of MS Access. I realised this could apply to my Nifty Date Picker it may not work in older versions of MS Access.
To Download the VBA code:- CLICK HERE
You can get this code for free!! Enter the coupon code:- === “buy uncle gizmo a coffee” Once you have the Code Module, construct the “Nifty Date Picker” by following the YouTube video instructions…
Hey Presto” You have a Free copy of the “Nifty Date Picker” that will work in ANY VERSION of MS Access.
Video 1 (18:39)
Buy Tony a coffee!
Nifty Date Picker - User Case Examples
Select Date & Use It In a Query
Select Date & Use It In a Query
Video 1 (6:21)
This version of the “Nifty Date Picker” demonstrates how to use the date selected in code on the form it was called from. This is a custom situation, and custom code. I also have a solution which uses a Class Module which would make the Code generic and enable it to work with any form in any situation. See my website for more information about the clsCallCalled Class Module. For the purposes of the demonstration I have added dates to the Sample file:- 12th Aug 2019 and 19th Aug 2019. If you click on either the 12th or the 19th you will see the results for those dates returned in the Query.
Video 1 (6:21)
Original OP Question on Access World Forums Here:-
More Links in the DATE MENU Below!
… …
Option Compare Database
Option Explicit
'This is the latest version of the code, Updated Jan the 27th 2020
'Fixed a bug with highlighting the date, removed a bit of redundant code.
'I have removed all my custom error handling code from this free sample.
'######## -------------- Variables for the Property Statements ------- ########
Private mctrlInitialDate As Control
Private mTempDate As Date 'Temporary Date
'############## ---------------- Property Statements ----------------- ########
Property Set prpCtrlInitialDate(ctrlInitialDate As Control)
Set mctrlInitialDate = ctrlInitialDate
End Property 'prpCtrlInitialDate Let
Property Get prpCtrlInitialDate() As Control
Set prpCtrlInitialDate = mctrlInitialDate
End Property 'prpCtrlInitialDate Get
Property Let prpTempDate(ByVal datTempDate As Date)
mTempDate = datTempDate
End Property 'prpTempDate Let
Property Get prpTempDate() As Date
prpTempDate = mTempDate
End Property 'prpTempDate Get
'############## ------------------ Control Events -------------------- ########
Private Sub btnToday_Click()
prpTempDate = Date
Me.txtMth = prpTempDate
Call fDisplayMth(prpTempDate)
Call fSetAndClose(True)
End Sub 'btnToday_Click
Private Sub btnYrPlus1_Click()
prpTempDate = DateAdd("yyyy", 1, prpTempDate)
Me.txtMth = prpTempDate
Call fDisplayMth(prpTempDate)
End Sub 'btnYrPlus1_Click
Private Sub btnYrMinus1_Click()
prpTempDate = DateAdd("yyyy", -1, prpTempDate)
Me.txtMth = prpTempDate
Call fDisplayMth(prpTempDate)
End Sub 'btnYrMinus1_Click
Private Sub btnMthMinus1_Click()
prpTempDate = DateAdd("m", -1, prpTempDate)
Me.txtMth = prpTempDate
Call fDisplayMth(prpTempDate)
End Sub 'btnMthMinus1_Click
Private Sub btnMthPlus1_Click()
prpTempDate = DateAdd("m", 1, prpTempDate)
Me.txtMth = prpTempDate
Call fDisplayMth(prpTempDate)
End Sub 'btnMthPlus1_Click
Private Sub Form_Load()
Me.Caption = Me.Name & " Ver B_1a "
End Sub 'Form_Load
Private Sub txtMth_AfterUpdate()
prpTempDate = Me.txtMth
Call fDisplayMth(prpTempDate)
End Sub 'txtMth_AfterUpdate
'############## ----------------- Primary Routines ------------------ ########
Public Function fSetUp()
If Not IsDate(prpCtrlInitialDate) Then 'Handle No Date Supplied
prpTempDate = Date
prpCtrlInitialDate = Date
Else
prpTempDate = prpCtrlInitialDate 'Separate the Object Date from the Processed Date
End If
Me.txtMth = prpTempDate
Call fDisplayMth(prpTempDate)
End Function 'fSetUp
Private Function fHighlightCurDate(ByVal dTempDate As Date, ByVal dInitialDate As Date)
Dim intInitialDay As Integer
intInitialDay = DatePart("d", dInitialDate)
'If the Day matches the month and year, then highlight it
If (DatePart("m", dTempDate) = DatePart("m", dInitialDate)) And (DatePart("yyyy", dTempDate) = DatePart("yyyy", dInitialDate)) Then
Dim Ctrl As Control
For Each Ctrl In Me.Controls
Select Case Ctrl.ControlType
Case acCommandButton
If Ctrl.Caption = intInitialDay And Ctrl.Tag = "C" Then
Ctrl.FontSize = 11
Ctrl.ForeColor = RGB(255, 255, 255)
Ctrl.BackColor = RGB(30, 144, 255)
End If
End Select
Next Ctrl
End If
End Function 'fHighlightCurDate
Private Function fDisplayMth(dInitialDate As Date)
Dim Ctrl As Control
Dim dFirstDayOfMth As Date
Dim intInitialDay As Integer
Dim intLastDayPrevMth As Integer
Dim intBtnTag As Integer 'Increment from 1 through to 42
Dim intPrevMth As Integer 'Increment the Previous Months Dates
Dim intInitialMth As Integer 'Increment the Alpha Months Dates (Current, Passed in Mth)
Dim intFollowMth As Integer 'Increment the Following Months Dates
dFirstDayOfMth = DateSerial(Year(dInitialDate), Month(dInitialDate), 1)
intLastDayPrevMth = DatePart("d", dFirstDayOfMth - 1)
intInitialDay = DatePart("d", dInitialDate)
intInitialMth = 1
intFollowMth = 1
intPrevMth = intLastDayPrevMth - Weekday(dFirstDayOfMth, vbMonday) + 2 'fWeekDayOffSet(dFirstDayOfMth) + 2
For Each Ctrl In Me.Controls
Select Case Ctrl.ControlType
Case acCommandButton
'Check to see if it is a Command Button in the 1 to 42 Grid (Its Prefix will be btnD)
If Left(Ctrl.Name, 4) = "btnD" Then
'Setup Form
Ctrl.BackColor = RGB(147, 202, 221)
Ctrl.ForeColor = RGB(16, 37, 63)
'1 through 42 Counter
intBtnTag = intBtnTag + 1
'Fill the Previous Month
If Weekday(dFirstDayOfMth, vbMonday) > 0 And intPrevMth <= intLastDayPrevMth Then
Ctrl.Tag = "P"
Ctrl.BackColor = RGB(219, 238, 244)
Ctrl.Caption = intPrevMth 'Set the Captions of the Command Buttons to the Previous month
intPrevMth = intPrevMth + 1
End If
'Fill the Initial Month
If intBtnTag >= Weekday(dFirstDayOfMth, vbMonday) Then
Ctrl.Caption = intInitialMth 'Set the Captions of the Command Buttons to the Alpha month
'intInitialMth
Ctrl.Tag = "C"
intInitialMth = intInitialMth + 1 'this is a poor name! it's a DAY not a month (Incremented = Incr)
End If
'Fill the Following Month
If intInitialMth > fLastDayOfMth(dFirstDayOfMth) + 1 Then
Ctrl.Tag = "F"
Ctrl.BackColor = RGB(219, 238, 244)
Ctrl.Caption = intFollowMth 'Set the Captions of the Command Buttons to the Following month
intFollowMth = intFollowMth + 1
End If
End If
End Select
Next Ctrl
Call fHighlightCurDate(prpTempDate, prpCtrlInitialDate)
End Function 'fDisplayMth
Private Function fGetCaption() As String
'The Calendar displays the 3 dates sections, previous month, current month and Following month.
'A value is placed in the Tag property of the command button to identify which date section the button belongs to
Dim intday As Integer
intday = Screen.ActiveControl.Caption
Select Case Screen.ActiveControl.Tag
Case Is = "P" 'Previous Month
prpTempDate = fDateBuilder(prpTempDate, -1, intday)
Case Is = "C" 'Current Month
prpTempDate = fDateBuilder(prpTempDate, 0, intday)
Case Is = "F" 'Following Month
prpTempDate = fDateBuilder(prpTempDate, 1, intday)
End Select
Call fSetAndClose(True)
End Function 'fGetCaption
Private Function fDateBuilder(dTempDate As Date, intOffSet As Integer, intday As Integer) As Date
'Used in Function fGetCaption()
Dim intYear As Integer
Dim intMth As Integer
dTempDate = DateAdd("m", intOffSet, dTempDate)
intYear = DatePart("yyyy", dTempDate)
intMth = DatePart("m", dTempDate)
fDateBuilder = intYear & "/" & intMth & "/" & intday
End Function 'fDateBuilder
Private Function fSetAndClose(blnSetDate As Boolean)
'This is the Exit Routine
If blnSetDate Then
prpCtrlInitialDate = prpTempDate 'Set the Object Date to the Processed Date
DoCmd.Close acForm, Me.Name
End If
End Function 'fSetAndClose
'############## ----------------- Helper Routines ------------------ ########
Private Function fLastDayOfMth(dDate As Date) As Byte
' DateSerial( year, month, day )
fLastDayOfMth = DatePart("d", DateSerial(Year(dDate), Month(dDate) + 1, 1) - 1)
End Function 'fLastDayOfMth
''''CALL IT Like THIS
'''Dim strFrmName As String
''' strFrmName = "NiftyDatePicker"
''' DoCmd.OpenForm strFrmName
''' With Forms(strFrmName)
''' Set .prpCtrlInitialDate = Me.txtEndDate
''' .fSetUp
''' '.Caption = "I CAN CHANGE THE CAPTION"
''' End With
