Как создать текстовое поле только с часовым форматом (ЧЧ: мм) на VBA

Question

Мне нужно создать TextBox, который работает только с форматом даты (ЧЧ: мм) Что пользователь может написать «Определенный час» (12:34), а не (12:65) или (1200), как я могу это сделать?

Код:

 Private Sub bTNOK_Click()

    TextBoxHour.Value = Format(TextBoxHour.Value, "HH:mm")

End Sub

Private Sub UserForm_Initialize()

    TextBoxHour.Value = "00:00"
    TextBoxHour.MaxLength = 5


End Sub

Спасибо за вашу помощь!

Answer 1

Использовать событие выхода

Private Sub TextBoxHour_Exit(ByVal Cancel As MSForms.ReturnBoolean)
        If IsDate(TextBoxHour.Value) And Len(TextBoxHour.Text) = 5 Then
        Else
            MsgBox "Input Hour like this Example 05:35"
            TextBoxHour.Text = ""
        End If
End Sub

Answer 2

Я бы предложил сделать булеву проверку, как предложил PGCodeRider. Вот моя предложенная функция

    Public Function IsGoodTime(ByVal strInString As String) As Boolean
        Dim blnOut As Boolean
        Dim intPos As Integer
        Dim strTemp As String
        Dim strLeft As String
        Dim strRight As String
        Dim intLeft As Integer
        Dim intRight As Integer

        blnOut = True
        strTemp = Trim(strInString)

        intPos = InStr(1, strTemp, ":")
        If intPos > 0 Then
            strLeft = Mid(strTemp, 1, intPos - 1)
            strRight = Mid(strTemp, intPos + 1, Len(strTemp))
        Else
            strRight = Right(strTemp, 2)
            strLeft = Mid(strTemp, 1, Len(strTemp) - 2)
        End If

        intLeft = 0
        intRight = 0
        If IsNumeric(strLeft) Then intLeft = CInt(strLeft)
        If IsNumeric(strRight) Then intRight = CInt(strRight)

        If (Not ((intLeft > 0) And (intLeft < 13))) Then blnOut = False
        If (Not ((intRight > 0) And (intRight < 60))) Then blnOut = False

        IsGoodTime = blnOut

    End Function

Answer 3

Лучше всего подойдет пользовательская функция, которая возвращает True или False. Если пользователь вводит что-то, что возвращает False, верните код и пользователь вводит новый номер.

Это было лучшее из того, что я мог придумать для защиты от неискушенных пользовательских записей.

Function CheckTime(inputasString) As Boolean

Dim theDoubleDotThing As Long

theDoubleDotThing = InStr(1, inputasString, ":", vbBinaryCompare)

If theDoubleDotThing = 0 Then
    GoTo NOPE
End If



Dim theHOUR As Long, theMinute As Long

On Error GoTo NOPE
    theHOUR = CLng(Mid(inputasString, 1, theDoubleDotThing - 1))
    theMinute = CLng(Right(inputasString, 2))
On Error GoTo 0

If Right(inputasString, 3) <> ":" & Right(inputasString, 2) Then
    GoTo NOPE

ElseIf theHOUR > 12 Then
    GoTo NOPE

ElseIf theMinute > 60 Then
    GoTo NOPE
End If

CheckTime = True

Exit Function
NOPE:


End Function

Так что вставьте это в свой код ....

Private Sub bTNOK_Click()

    If CheckTime(textboxhour.Value) Then

    textboxhour.Value = Format(textboxhour.Value, "HH:mm")

    Else
        MsgBox "what the heck is " & textboxhour.Value & "?!?!?", vbCritical, Title:="Come On Man"

    End If

End Sub

EDIT Чтобы помочь оператору, я создал пример файла , в котором есть кнопка для приглашения, а затем проверяется строка.