SpinButton Control for Selecting Time


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

1
Option Compare Database
1
Option Explicit

 

1
Private dteSelected As Date
1
Private dteTime As Date
1
Private dblValue As Double
1
Private intChoice As Integer
1
Private intValue As Integer
1
Private strAMPM As String
1
Private strControlName As String
1
Private strNewTime As String
1
Private strPrompt As String
1
Private strSwapAMPM As String
1
Private strTime As String
1
Private strTitle As String
1
Private txt As Access.TextBox

 

 

1
Private Sub cmdSwitchAMPM_Click()

 

1
On Error GoTo ErrorHandler

 

1
Set txt = Me![txtSelectedTime]
1
strTime = txt.Value
1
strAMPM = Right(strTime, 2)
1
strNewTime = Left(strTime, Len(strTime) - 2)
1
strSwapAMPM = Switch(strAMPM = "AM", "PM", _
1
strAMPM = "PM", "AM")
1
strNewTime = strNewTime & strSwapAMPM
1
Debug.Print "New time: " & strNewTime
1
dteTime = CDate(strNewTime)
1
txt.Value = dteTime

 

1
If IsDate(Me![txtSelectedDate].Value) = True And _
1
IsDate(Me![txtSelectedTime].Value) = True Then
1
dteSelected = CDate(CStr(Me![txtSelectedDate].Value) & " " _
1
& CStr(dteTime))
1
Debug.Print "Date and Time: " & dteSelected
1
Me![txtSelectedDateTime].Value = dteSelected
1
End If

 

1
ErrorHandlerExit:
1
Exit Sub

 

1
ErrorHandler:
1
MsgBox "Error No: " & Err.Number _
1
& " in " & Me.ActiveControl.Name & " procedure; " _
1
& "Description: " & Err.Description
1
Resume ErrorHandlerExit

 

1
End Sub

 

1
Private Sub Form_Load()

 

1
On Error Resume Next

 

1
DoCmd.RunCommand acCmdSizeToFitForm

 

1
On Error GoTo ErrorHandler

 

1
<strong><em>   'Set initial value of increment/decrement number for</em></strong>
1
<strong><em>   'SpinButton control</em></strong>
1
Me![txtIncDecTime].Value = 15
1
Me![fraTimeSelection].Value = 1

 

1
ErrorHandlerExit:
1
Exit Sub

 

1
ErrorHandler:
1
MsgBox "Error No: " &amp; Err.Number _
1
&amp; " in " &amp; Me.Name &amp; " Form_Load procedure; " _
1
&amp; "Description: " &amp; Err.Description
1
Resume ErrorHandlerExit
1
End Sub

 

1
Private Sub fraTimeSelection_AfterUpdate()
1
On Error GoTo ErrorHandler

 

1
intChoice = Nz(Me![fraTimeSelection].Value, 1)

 

1
Select Case intChoice

 

1
Case 1
1
Me![txtIncDecTime].Value = 15

 

1
Case 2
1
Me![txtIncDecTime].Value = 1

 

1
End Select

 

1
ErrorHandlerExit:
1
Exit Sub

 

1
ErrorHandler:
1
MsgBox "Error No: " &amp; Err.Number _
1
&amp; " in " &amp; Me.ActiveControl.Name &amp; " procedure; " _
1
&amp; "Description: " &amp; Err.Description
1
Resume ErrorHandlerExit

 

1
End Sub

 

1
Private Sub spnTime_SpinDown()

 

1
On Error Resume Next

 

1
Call DecrementTime

 

1
End Sub

 

1
Private Sub spnTime_SpinUp()

 

1
On Error Resume Next

 

1
Call IncrementTime

 

1
End Sub

 

1
Private Sub IncrementTime()

 

1
On Error GoTo ErrorHandler

 

1
Set txt = Me![txtSelectedTime]

 

1
<strong><em>   'Get or create start time value</em></strong>
1
If IsDate(txt.Value) = False Then
1
dteTime = #9:00:00 AM#
1
Else
1
dteTime = CDate(txt.Value)
1
End If

 

1
dblValue = CDbl(Me![txtIncDecTime].Value)

 

1
If dblValue = 0 Then
1
strTitle = "Problem"
1
strPrompt = "Please enter the amount of time to increase or decrease"
1
MsgBox prompt:=strPrompt, _
1
buttons:=vbExclamation + vbOKOnly, _
1
Title:=strTitle
1
Me![txtIncDecTime].SetFocus
1
GoTo ErrorHandlerExit
1
End If

 

1
intChoice = Nz(Me![fraTimeSelection].Value, 1)

 

1
Select Case intChoice

 

1
Case 1
1
<strong><em>         'Increment time value by minutes</em></strong>
1
dteTime = DateAdd("n", dblValue, dteTime)

 

1
Case 2
1
<strong><em>         'Increment time value by hours</em></strong>
1
dteTime = DateAdd("h", dblValue, dteTime)

 

1
End Select

 

1
txt.Value = dteTime

 

1
If IsDate(Me![txtSelectedDate].Value) = True And _
1
IsDate(Me![txtSelectedTime].Value) = True Then
1
dteSelected = CDate(CStr(Me![txtSelectedDate].Value) &amp; " " _
1
&amp; CStr(dteTime))
1
'Debug.Print "Date and Time: " &amp; dteSelected
1
Me![txtSelectedDateTime].Value = dteSelected
1
End If

 

1
ErrorHandlerExit:
1
Exit Sub

 

1
ErrorHandler:
1
MsgBox "Error No: " &amp; Err.Number _
1
&amp; " in IncrementTime procedure; " _
1
&amp; "Description: " &amp; Err.Description
1
Resume ErrorHandlerExit

 

1
End Sub

 

1
Private Sub DecrementTime()

 

1
On Error GoTo ErrorHandler

 

1
Set txt = Me![txtSelectedTime]

 

1
<strong><em>   'Get or create start time value</em></strong>
1
If IsDate(txt.Value) = False Then
1
dteTime = #9:00:00 AM#
1
Else
1
dteTime = CDate(txt.Value)
1
End If

 

1
dblValue = CDbl(Me![txtIncDecTime].Value)

 

1
If dblValue = 0 Then
1
strTitle = "Problem"
1
strPrompt = "Please enter the amount of time to increase or decrease"
1
MsgBox prompt:=strPrompt, _
1
buttons:=vbExclamation + vbOKOnly, _
1
Title:=strTitle
1
Me![txtIncDecTime].SetFocus
1
GoTo ErrorHandlerExit
1
End If

 

1
intChoice = Nz(Me![fraTimeSelection].Value, 1)

 

1
Select Case intChoice

 

1
Case 1
1
<strong><em>         'Decrement time value by minutes</em></strong>
1
dteTime = DateAdd("n", -dblValue, dteTime)

 

1
Case 2
1
<strong><em>         'Decrement time value by hours</em></strong>
1
dteTime = DateAdd("h", -dblValue, dteTime)

 

1
End Select

 

1
txt.Value = dteTime

 

1
If IsDate(Me![txtSelectedDate].Value) = True And _
1
IsDate(Me![txtSelectedTime].Value) = True Then
1
dteSelected = CDate(CStr(Me![txtSelectedDate].Value) &amp; " " _
1
&amp; CStr(dteTime))
1
'Debug.Print "Date and Time: " &amp; dteSelected
1
Me![txtSelectedDateTime].Value = dteSelected
1
End If

 

1
ErrorHandlerExit:
1
Exit Sub

 

1
ErrorHandler:
1
MsgBox "Error No: " &amp; Err.Number _
1
&amp; " in DecrementTime procedure; " _
1
&amp; "Description: " &amp; Err.Description
1
Resume ErrorHandlerExit

 

1
End Sub

 

1
Private Sub txtSelectedDate_AfterUpdate()

 

1
On Error GoTo ErrorHandler

 

1
<strong><em>   'Create start time value, if needed</em></strong>
1
Set txt = Me![txtSelectedTime]

 

1
If IsDate(txt.Value) = False Then
1
dteTime = #9:00:00 AM#
1
txt.Value = dteTime
1
End If

 

1
Me![txtSelectedDateTime].Value = Null

 

1
ErrorHandlerExit:
1
Exit Sub

 

1
ErrorHandler:
1
MsgBox "Error No: " &amp; Err.Number _
1
&amp; " in " &amp; Me.ActiveControl.Name &amp; " procedure; " _
1
&amp; "Description: " &amp; Err.Description
1
Resume ErrorHandlerExit

 

1
End Sub

 

1
Private Sub txtSelectedTime_AfterUpdate()

 

1
On Error GoTo ErrorHandler

 

1
If CDate(Me![txtSelectedDate].Value) = True And _
1
CDate(Me![txtSelectedTime].Value) = True Then
1
dteSelected = CDate(CStr(Me![txtSelectedDate].Value) &amp; " " _
1
&amp; CStr(Me![txtSelectedTime].Value))
1
Me![txtSelectedDateTime].Value = dteSelected
1
End If

 

1
ErrorHandlerExit:
1
Exit Sub

 

1
ErrorHandler:
1
MsgBox "Error No: " &amp; Err.Number _
1
&amp; " in " &amp; Me.ActiveControl.Name &amp; " procedure; " _
1
&amp; "Description: " &amp; Err.Description
1
Resume ErrorHandlerExit

 

1
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

Want More?

Office Watch has the latest news and tips about Microsoft Office.  Delivered once a week.