Question

我需要创建一个仅适用于日期格式（HH：mm）的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

返回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

编辑为了帮助OP，我构建了一个sample file，该按钮具有用于提示的按钮，然后测试该字符串。

Answer 3

我建议按照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

如何在VBA上仅使用小时格式（HH：mm）创建文本框

3 个答案: