Ограничить ввод пользовательской формы текстовым полем [H]: MM

Question

У меня есть несколько текстовых полей для нескольких пользовательских форм, которые предназначены для распределения времени. Для простоты скажем userform1 & userform2, с textbox1 & textbox2 на каждом. Userform1 предназначен для ввода пользователем, который помещает значения в таблицу, а userform2 извлекает значения из этой таблицы и отображает в соответствующем текстовом поле. Мне нужно ограничить как ввод этих полей, так и отображение в формате [H]: мм, где минуты не могут превышать 59, но часы могут быть больше 25+, т.е. 125: 59, но не 4: 67

Я попробовал комбинацию кода из этих и других потоков, но не могу заставить его работать.

Проверка времени текстового поля Excel VBA до [ч]: мм

Формат времени текстового поля в форме пользователя Excel

в конце концов я просто попытался манипулировать пользовательским вводом с помощью окон сообщений, но это все еще оставляет записи открытыми для ошибки

Sub FormatHHMM(textbox As Object)

Dim timeStr As String

With textbox

'Check if user put in a colon or not
     If InStr(1, .Value, ":", vbTextCompare) = 0 And Len(.Value) > 1 Then

        MsgBox "Please use HH:mm Format"

        textbox.Value = ""
        textbox.SetFocus
    Else
        If Right(.Value, 2) > 60 Then

        MsgBox "Minutes cannot be more than 59"

        textbox.Value = ""
        textbox.SetFocus

        End If

End If
End With


End Sub

это позволяет пользователям вводить буквенные символы, и даже если правильный ввод при вызове из таблицы отображается как значение вместо, т.е. 5.234 ... вместо 125: 59

Answer 1

Как насчет того, чтобы разделить часы и минуты на два отдельных поля ввода в одном поле ввода? Таким образом, пользователь должен ввести часы и следующие минуты поля. Таким образом, вы можете проверить ввод для числового и> 60 для секунд. Я знаю, что это не идеал, но это был бы способ избежать данных проблем.

Answer 2

Вы пытались использовать оператор Like? Это позволяет проверять числовые значения в каждой позиции символа. Я бы сделал это так:

Function FormatCheck(ByVal strEntered As String)

Dim correctformat As Boolean

If strEntered Like "*#:##" And IsNumeric(Mid(strEntered, 1, InStr(1, strEntered, ":", 1) - 1)) Then
    If Mid(strEntered, InStr(1, strEntered, ":", 1) + 1, 999) <= 59 Then
        correctformat = True
    End If
End If

If Not correctformat Then FormatCheck = "Incorrect format"

End Function

Для этого требуется хотя бы одно число перед ":"

Редактировать: Ниже приведена версия Sub вместо использования Function. Появится MsgBox, как вы использовали изначально. Вы могли бы, вероятно, заменить всю вашу сабвуфер FormatHHMM без каких-либо отрицательных последствий.

Sub FormatCheck(ByVal strEntered As String)

Dim correctformat As Boolean

If strEntered Like "*#:##" And IsNumeric(Mid(strEntered, 1, InStr(1, strEntered, ":", 1) - 1)) Then
    If Mid(strEntered, InStr(1, strEntered, ":", 1) + 1, 999) <= 59 Then
        correctformat = True
    End If
End If

If Not correctformat Then MsgBox "Incorrect format"

End Sub

Answer 3

Вы можете использовать регулярные выражения:

Sub inputTimeFormat()
    Dim userInput As String
    Dim strPattern As String
    Dim msgBoxText As String
    Dim regEx As New RegExp
    Dim objRegex As Object

    strPattern = "(^[0-9]+):([0-5])([0-9])$"
    msgBoxText = "Insert time in HH:mm, or hit Cancel to escape"
    Set objRegex = CreateObject("vbscript.regexp")

    With regEx
        .ignorecase = True
        .Pattern = strPattern
        Do
            If userInput <> vbNullString Then msgBoxText = "PLEASE RETRY" & Chr(13) & msgBoxText
            userInput = Application.InputBox(msgBoxText, Default:="17:01")
            If userInput = "False" Then
                MsgBox "User hit cancel, exiting code", vbCritical
                Exit Sub
            End If
        Loop Until .Test(userInput)
    End With

    MsgBox "Format OK"

End Sub

(необходимо активировать регулярные выражения: в VBA «Сервис»> «Ссылки»> установите флажок «Регулярные выражения Microsoft VBScript 5.5»> «ОК») Подробнее о Как использовать регулярные выражения (регулярные выражения) в Microsoft Excel как в ячейках, так и в циклах

Answer 4

Я думаю, что это может быть полезно:

Option Explicit

Sub test()

    Dim str As String

    str = TextBox.Value

    'Test string lenght. Maximun lenght number 4
    If Len(str) <> 4 Then
        MsgBox "Enter a valid time. Proper number of digits are 4."
        Exit Sub
    End If

    'Test if string includes only one ":"
    If (Len(str) - Len(Replace(str, ":", ""))) / Len(":") <> 1 Then
        MsgBox "Use only one "":"" to separate time."
        Exit Sub
    End If

    'Test how many digits are before and after ":"
    If InStr(1, str, ":") <> 2 Then
        MsgBox """:"" position should be place 2."
        Exit Sub
    End If

    'Test if number 1,3 & 4 are number
    If IsNumeric(Mid(str, 1, 1)) = False Or IsNumeric(Mid(str, 1, 1)) = False Or IsNumeric(Mid(str, 1, 1)) = False Then
        MsgBox "Enter number in position 1,3 and 4."
        Exit Sub
    End If

   'Test 2 last to digits
    If Right(str, 2) <= 60 Then
        MsgBox "Second limit is 60."
        Exit Sub
    End If


End Sub