CheckTime

'convert (most of) any
input
to a time

Public Function CheckTijd(bron$) As Date

dim
t%
'checking
on
digits and seperator
Const Getal$ = "1234567890.:"

For t% = 1 To Len(bron$)
If InStr(Getal$, Mid$(bron$, t%, 1)) = 0 Then
exit
Function
If Mid$(bron$, t%, 1) = "." Then bron$ = Left$(bron$, t% - 1) & ":" & Right$(bron$, Len(bron$) - t%)
Next t%


select

case
Len(bron$)

case
0

exit
Function

case
1
bron$ = "0" & bron$ & ":00"

case
2
bron$ = bron$ & ":00"

case
3
t% = InStr(bron$, ":")
If t% = 0 Then _
bron$ = Left$(bron$, 1) & ":" & Right$(bron$, 2)

case
4
t% = InStr(bron$, ":")
If t% = 0 Then _
bron$ = Left$(bron$, 2) & ":" & Right$(bron$, 2)

case
5
bron$ = Left$(bron$, 2) & ":" & Right$(bron$, 2)

end
Select


on
Error Resume Next
CheckTijd = TimeValue(bron$)

End Function

'use it in the Text_Lostfocus event like

Sub Text1_LostFocus
Text1.Text = CheckTijd(Text1.Text)
End Sub

'giving the
input
in text1 => result
'1 => 01:00
'12 => 12:00
'1.1 => 01:10
'915 => 9:15
'9.15 => 9:15
'1015 => 10:15
'10.15 => 10:15
'12:15 => 12:15

'giving an impossible
time
=> result
'26 => 00:00
'1976 => 00:00

'giving just nothing (TAB/ENTER) will give no result

No comments: