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

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

Want More?

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