Looking for a Date?

Last post I introduced frmSelect_Multiple that helps users find:
- Codes/Types by Code/Type or Description
- Cities by Zipcode or Name
- Accounts by Number or Description
- Employees, Customers, or Vendors by ID/Number or Name
- Inventory/Stock Items or Products by SKU/UPC/GTIN or Description
- Books by ISBN or Title
- etc., etc.
I promised to show in this post how frmSelect_Multiple integrates to frmPrompt without code changes. I ask your forgiveness as I introduce another support form for frmPrompt instead, frmDatePicker.
Shown at right is frmDatePicker. It is inspired heavily by an article in VBA Tips. Why I haven’t included this long ago is only a testament to my ability to overlook the obvious sometimes. Oh, well, better late than never.
First, get to the VBE (Alt-F11) and add the Microsoft Calendar Control using the menu path Tools > References -or- Tools > Additional Controls. Add the following controls:
Name | Type | Properties |
frmDatePicker | UserForm | Caption:=“Pick Date” |
calCalendar | Calendar | ShowTitle:=False |
cmdExit | CommandButton | Caption:=”OK”, Default:=True, TabStop:=False |
cmdOK | CommandButton | Caption:=”Exit”, Cancel:=True, TabStop:=False |
The command buttons should be behind the calendar control. They need to be there to respond to the keyboard. Remember there are still some of us around that like the keyboard (which is why I probably very inconsiderately overlooked this form for so long).
Add this code
'Version: 12/01/09
Option Explicit
Dim bOK As Boolean
' Name: frmDatePicker
' Purpose:Display a status message under program control to the user
' Date Init Modification
' 12/01/09 CWH Initial Programming
' Example (How to use this form):
'Private Sub cmdFrom_Click()
' On Error GoTo ErrorHandler
' With frmDatePicker ' .Top = Me.Top + cmdFrom.Top + 20 ' .Left = Me.Left + cmdFrom.Left + cmdFrom.Width + 8 ' .pDate = IIf(IsDate(txtFrom), CDate(txtFrom), Int(Now())) ' .Show ' Do While .Visible ' DoEvents ' Loop ' If .pOK Then txtFrom = .pDate ' End With
'ErrorHandler:
' On Error GoTo 0
'End Sub
'Properties
' Date Public Property Let pDate(dDate As Date) If IsDate(dDate) Then With calCalendar .Day = Day(dDate) .Month = Month(dDate) .Year = Year(dDate) End With End If End Property Public Property Get pDate() As Date With calCalendar pDate = DateSerial(.Year, .Month, .Day) End With End Property
' OK Public Property Get pOK() As Boolean pOK = bOK End Property
' Event Handlers Private Sub calCalendar_DblClick() cmdOK_Click End Sub
Private Sub calCalendar_Exit(ByVal Cancel As MSForms.ReturnBoolean) bOK = False Me.Hide End Sub
Private Sub cmdExit_Click() bOK = False Me.Hide End Sub
Private Sub cmdOK_Click() bOK = True Me.Hide End Sub
Next post I promise most sincerely to integrate all of this into a better, frmPrompt.
 Comment on this Post