Introduction
Recently I had occasion to update an Access database that used a DateTimePicker ActiveX control for selecting times. This control had worked for many years (about 15 years in this case), but stopped working when the user updated to 64-bit Windows 10. I was able to replicate the functionality of the old ActiveX control with a textbox and a Microsoft Forms SpinButton control. This article shows how to use this handy method for quickly changing a time value.
The Form
The sample database has only one table and one form. The form opens in DataEntry mode, to a blank record:
Figure A. The Date and Time Selection form as opened
Initially, the value for changing times is set at 15 minutes; you can select the Hours option (which changes the value to 1), and enter a different number to change the time by more or less minutes or hours.
Select a date from the built-in DatePicker, or enter it manually:
Figure B. Selecting a date from the DatePicker
The time is initially set to 9:00:00 AM (this is the default value of the txtSelectedTime textbox; it can be reset to another time as you wish). Click the Up arrow on the SpinButton control to increase the time, or the Down arrow to decrease the time; the complete date and time is displayed in the Selected Date and Time textbox:
Figure C. Increasing or decreasing the time using the SpinButton control
The button to the right of the SpinButton control switches AM and PM.
VBA Code
Option Compare Database
Option Explicit
Private dteSelected As Date
Private dteTime As Date
Private dblValue As Double
Private intChoice As Integer
Private intValue As Integer
Private strAMPM As String
Private strControlName As String
Private strNewTime As String
Private strPrompt As String
Private strSwapAMPM As String
Private strTime As String
Private strTitle As String
Private txt As Access.TextBox
Private Sub cmdSwitchAMPM_Click()
On Error GoTo ErrorHandler
Set txt = Me![txtSelectedTime]
strTime = txt.Value
strAMPM = Right(strTime, 2)
strNewTime = Left(strTime, Len(strTime) - 2)
strSwapAMPM = Switch(strAMPM = "AM", "PM", _
strAMPM = "PM", "AM")
strNewTime = strNewTime & strSwapAMPM
Debug.Print "New time: " & strNewTime
dteTime = CDate(strNewTime)
txt.Value = dteTime
If IsDate(Me![txtSelectedDate].Value) = True And _
IsDate(Me![txtSelectedTime].Value) = True Then
dteSelected = CDate(CStr(Me![txtSelectedDate].Value) & " " _
& CStr(dteTime))
Debug.Print "Date and Time: " & dteSelected
Me![txtSelectedDateTime].Value = dteSelected
End If
ErrorHandlerExit:
Exit Sub
ErrorHandler:
MsgBox "Error No: " & Err.Number _
& " in " & Me.ActiveControl.Name & " procedure; " _
& "Description: " & Err.Description
Resume ErrorHandlerExit
End Sub
Private Sub Form_Load()
On Error Resume Next
DoCmd.RunCommand acCmdSizeToFitForm
On Error GoTo ErrorHandler
'Set initial value of increment/decrement number for
'SpinButton control
Me![txtIncDecTime].Value = 15
Me![fraTimeSelection].Value = 1
ErrorHandlerExit:
Exit Sub
ErrorHandler:
MsgBox "Error No: " & Err.Number _
& " in " & Me.Name & " Form_Load procedure; " _
& "Description: " & Err.Description
Resume ErrorHandlerExit
End Sub
Private Sub fraTimeSelection_AfterUpdate()
On Error GoTo ErrorHandler
intChoice = Nz(Me![fraTimeSelection].Value, 1)
Select Case intChoice
Case 1
Me![txtIncDecTime].Value = 15
Case 2
Me![txtIncDecTime].Value = 1
End Select
ErrorHandlerExit:
Exit Sub
ErrorHandler:
MsgBox "Error No: " & Err.Number _
& " in " & Me.ActiveControl.Name & " procedure; " _
& "Description: " & Err.Description
Resume ErrorHandlerExit
End Sub
Private Sub spnTime_SpinDown()
On Error Resume Next
Call DecrementTime
End Sub
Private Sub spnTime_SpinUp()
On Error Resume Next
Call IncrementTime
End Sub
Private Sub IncrementTime()
On Error GoTo ErrorHandler
Set txt = Me![txtSelectedTime]
'Get or create start time value
If IsDate(txt.Value) = False Then
dteTime = #9:00:00 AM#
Else
dteTime = CDate(txt.Value)
End If
dblValue = CDbl(Me![txtIncDecTime].Value)
If dblValue = 0 Then
strTitle = "Problem"
strPrompt = "Please enter the amount of time to increase or decrease"
MsgBox prompt:=strPrompt, _
buttons:=vbExclamation + vbOKOnly, _
Title:=strTitle
Me![txtIncDecTime].SetFocus
GoTo ErrorHandlerExit
End If
intChoice = Nz(Me![fraTimeSelection].Value, 1)
Select Case intChoice
Case 1
'Increment time value by minutes
dteTime = DateAdd("n", dblValue, dteTime)
Case 2
'Increment time value by hours
dteTime = DateAdd("h", dblValue, dteTime)
End Select
txt.Value = dteTime
If IsDate(Me![txtSelectedDate].Value) = True And _
IsDate(Me![txtSelectedTime].Value) = True Then
dteSelected = CDate(CStr(Me![txtSelectedDate].Value) & " " _
& CStr(dteTime))
'Debug.Print "Date and Time: " & dteSelected
Me![txtSelectedDateTime].Value = dteSelected
End If
ErrorHandlerExit:
Exit Sub
ErrorHandler:
MsgBox "Error No: " & Err.Number _
& " in IncrementTime procedure; " _
& "Description: " & Err.Description
Resume ErrorHandlerExit
End Sub
Private Sub DecrementTime()
On Error GoTo ErrorHandler
Set txt = Me![txtSelectedTime]
'Get or create start time value
If IsDate(txt.Value) = False Then
dteTime = #9:00:00 AM#
Else
dteTime = CDate(txt.Value)
End If
dblValue = CDbl(Me![txtIncDecTime].Value)
If dblValue = 0 Then
strTitle = "Problem"
strPrompt = "Please enter the amount of time to increase or decrease"
MsgBox prompt:=strPrompt, _
buttons:=vbExclamation + vbOKOnly, _
Title:=strTitle
Me![txtIncDecTime].SetFocus
GoTo ErrorHandlerExit
End If
intChoice = Nz(Me![fraTimeSelection].Value, 1)
Select Case intChoice
Case 1
'Decrement time value by minutes
dteTime = DateAdd("n", -dblValue, dteTime)
Case 2
'Decrement time value by hours
dteTime = DateAdd("h", -dblValue, dteTime)
End Select
txt.Value = dteTime
If IsDate(Me![txtSelectedDate].Value) = True And _
IsDate(Me![txtSelectedTime].Value) = True Then
dteSelected = CDate(CStr(Me![txtSelectedDate].Value) & " " _
& CStr(dteTime))
'Debug.Print "Date and Time: " & dteSelected
Me![txtSelectedDateTime].Value = dteSelected
End If
ErrorHandlerExit:
Exit Sub
ErrorHandler:
MsgBox "Error No: " & Err.Number _
& " in DecrementTime procedure; " _
& "Description: " & Err.Description
Resume ErrorHandlerExit
End Sub
Private Sub txtSelectedDate_AfterUpdate()
On Error GoTo ErrorHandler
'Create start time value, if needed
Set txt = Me![txtSelectedTime]
If IsDate(txt.Value) = False Then
dteTime = #9:00:00 AM#
txt.Value = dteTime
End If
Me![txtSelectedDateTime].Value = Null
ErrorHandlerExit:
Exit Sub
ErrorHandler:
MsgBox "Error No: " & Err.Number _
& " in " & Me.ActiveControl.Name & " procedure; " _
& "Description: " & Err.Description
Resume ErrorHandlerExit
End Sub
Private Sub txtSelectedTime_AfterUpdate()
On Error GoTo ErrorHandler
If CDate(Me![txtSelectedDate].Value) = True And _
CDate(Me![txtSelectedTime].Value) = True Then
dteSelected = CDate(CStr(Me![txtSelectedDate].Value) & " " _
& CStr(Me![txtSelectedTime].Value))
Me![txtSelectedDateTime].Value = dteSelected
End If
ErrorHandlerExit:
Exit Sub
ErrorHandler:
MsgBox "Error No: " & Err.Number _
& " in " & Me.ActiveControl.Name & " procedure; " _
& "Description: " & Err.Description
Resume ErrorHandlerExit
End Sub
References
The code in the sample database needs the following reference (in addition to the default references):
Microsoft Forms 2.0 Object Library
If you import code or objects into a database of your own, you may need to set one or more of these references. The version number may differ, depending on your Office version; check the version you have. References are set in the References dialog, opened from the VBA window. For more information on working with references, see Access Archon #107, Working with References.
Supporting Files
The zip file containing this article, in Word 97-2003 format, plus the supporting file(s), may be downloaded from the Access Archon page of my Web site, as accarch247.zip, which is the last entry in the table of Access Archon columns for Access Watch.
| Document Name | Document Type | Place in |
| SpinButton Control (AA 247).accdb | Access 2007-2010 database (can also be used in higher versions of Access) | Wherever you want |
