CODEWITHSUNDEEP
ms-accesstime
Aimee
Aimee

Reputation: 57

MS Access Textbox Time control

I am wondering if it is possible to control the time entered into MS Access textbox. Eg, only allow user to enter time in half hourly interval (08:30, 10:00, 13:30) as I do not want to end up with weird timing input.. (i.e 13:37, 16:42). Tried to use calculated control but doesn't seem to be working very well. Any suggestions or advice, please?

Calculated control in my textbox

=IIf((Minute([TxtStartTime1]) Mod 30=0),[TxtStartTime1],"00:00")

Below is a screen capture of my form.

MS Access Txtbx Time Control

Upvotes: 0

Views: 368

Answers (2)

Gustav
Gustav

Reputation: 55806

Yes, that is possible, but it takes a little - actually that much, that I wrote an article on how-to:

Entering 24-hour time with input mask and full validation in Microsoft Access

It includes all the code needed to set the inputmask, validation, click and keypress events, as well as handling the form error - too much to post here.

Code is also on GitHub: VBA.TimeEntry

To round the time, you may include this function:

Public Function RoundTime( _
    ByVal datDate As Date) _
    As Date

    Const cintMult As Integer = 24 '1 hour round
    ' Const cintMult As Integer = 48 '30 minute round
    ' Const cintMult As Integer = 96 '15 minute round
    ' Const cintMult As Integer = 144 '10 minute round
    ' Const cintMult As Integer = 288 '5 minute round

    RoundTime = CVDate(Int(datDate * cintMult + 0.5) / cintMult)

End Function

Upvotes: 1

Sergey S.
Sergey S.

Reputation: 6336

You can round entered time for instance in BeforeUpdate event of your control. For rounding I use this VBA function:

Public Function TimeRoundMinutes(dtUnrounded As Date, Optional intRoundTo As Integer = 30, Optional intOption As Integer) As Date
'rounds time of provided date to specified in intRoundTo number of minutes. intOption:
'1 - down
'2 - up
'0 or anything else - to the nearest part
    Dim intMins As Integer

    If intRoundTo <= 0 Then
        intRoundTo = 1
    ElseIf intRoundTo > 60 Then
        intRoundTo = 60
    End If
    intMins = Minute(dtUnrounded)
    Select Case intOption
        Case 1
            intMins = Int(intMins / intRoundTo) * intRoundTo
        Case 2
            intMins = -Int(-intMins / intRoundTo) * intRoundTo
        Case Else
            intMins = Round(intMins / intRoundTo) * intRoundTo
    End Select

    If intMins = 60 Then
        TimeRoundMinutes = DateAdd("h", 1, Int(dtUnrounded) + TimeSerial(Hour(dtUnrounded), 0, 0))
    Else
        TimeRoundMinutes = Int(dtUnrounded) + TimeSerial(Hour(dtUnrounded), intMins, 0)
    End If
End Function

Upvotes: 0

Related Questions