Question

我想阻止一些特定的文本框只有数值并接受“。”。但是，它几乎阻止了我的用户窗体中的所有文本框。我不明白为什么。我在代码中忘记了什么？

bytes

Answer 1

这个对我有用：

Private Sub tbxHour_AfterUpdate()

    'Make sure the item is Numeric or has a "." in it
    If Not IsNumeric(Me.tbxHour.Text) And Not Me.tbxHour.Text = "." Then

        MsgBox "This is illegal!"
        Me.tbxHour.Text = ""

    End If

End Sub

短。简单。有效，看起来就像你想要做的那样。

Answer 2

我只使用这个NumKeyValidator类来简单地阻止用户提供无效输入：

Option Explicit
Private Const vbKeyDot As Integer = 46

Public Function IsValidKeyAscii(ByVal keyAscii As Integer, ByVal value As String) As Boolean
'returns true if specified keyAscii is a number, or if it's a dot and value doesn't already contain one
    IsValidKeyAscii = (keyAscii = vbKeyDot And InStr(1, value, Chr$(vbKeyDot)) = 0) Or (keyAscii >= vbKey0 And keyAscii <= vbKey9)
End Function

您只需为其声明一个实例字段即可使用它：

Private validator As New NumKeyValidator

然后在每个文本框“KeyPress处理程序中使用它，如下所示：

Private Sub tbxHour_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    If Not validator.IsValidKeyAscii(keyAscii, tbxHour.Value) Then keyAscii = 0
End Sub

无需处理Exit并弹出MsgBox然后 - 该框为空，或者包含有效数字;你可以有IsValidForm属性，如果所有必需的文本框都包含数字，则返回True，否则返回false - 然后在表单有效之前确定表单的 Ok 按钮被禁用

FWIW验证器类已经过全面测试（使用Rubberduck单元测试[免责声明：我拥有该开源VBE插件项目]）：

Option Explicit
Option Private Module

'@TestModule
'' uncomment for late-binding:
Private Assert As Object
'' early-binding requires reference to Rubberduck.UnitTesting.tlb:
'Private Assert As New Rubberduck.AssertClass

'@TestMethod
Public Sub DotIsValidForEmptyValue()
    On Error GoTo TestFail

    'Arrange:
    Dim actual As Boolean
    Dim sut As New NumKeyValidator

    'Act:
    actual = sut.IsValidKeyAscii(Asc("."), vbNullString)

    'Assert:
    Assert.IsTrue actual

TestExit:
    Exit Sub
TestFail:
    Assert.Fail "Test raised an error: #" & Err.Number & " - " & Err.Description
End Sub

'@TestMethod
Public Sub DotIsValidForNonEmptyValueWithoutAnyDots()
    On Error GoTo TestFail

    'Arrange:
    Dim actual As Boolean
    Dim sut As New NumKeyValidator

    'Act:
    actual = sut.IsValidKeyAscii(Asc("."), "123")

    'Assert:
    Assert.IsTrue actual

TestExit:
    Exit Sub
TestFail:
    Assert.Fail "Test raised an error: #" & Err.Number & " - " & Err.Description
End Sub

'@TestMethod
Public Sub DotIsInvalidWhenValueHasDot()
    On Error GoTo TestFail

    'Arrange:
    Dim actual As Boolean
    Dim sut As New NumKeyValidator

    'Act:
    actual = sut.IsValidKeyAscii(Asc("."), "123.45")

    'Assert:
    Assert.IsFalse actual

TestExit:
    Exit Sub
TestFail:
    Assert.Fail "Test raised an error: #" & Err.Number & " - " & Err.Description
End Sub

'@TestMethod
Public Sub AllDigitsAreValid()
    On Error GoTo TestFail

    Dim sut As New NumKeyValidator

    Assert.IsTrue sut.IsValidKeyAscii(Asc("0"), vbNullString)
    Assert.IsTrue sut.IsValidKeyAscii(Asc("1"), vbNullString)
    Assert.IsTrue sut.IsValidKeyAscii(Asc("2"), vbNullString)
    Assert.IsTrue sut.IsValidKeyAscii(Asc("3"), vbNullString)
    Assert.IsTrue sut.IsValidKeyAscii(Asc("4"), vbNullString)
    Assert.IsTrue sut.IsValidKeyAscii(Asc("5"), vbNullString)
    Assert.IsTrue sut.IsValidKeyAscii(Asc("6"), vbNullString)
    Assert.IsTrue sut.IsValidKeyAscii(Asc("7"), vbNullString)
    Assert.IsTrue sut.IsValidKeyAscii(Asc("8"), vbNullString)
    Assert.IsTrue sut.IsValidKeyAscii(Asc("9"), vbNullString)

TestExit:
    Exit Sub
TestFail:
    Assert.Fail "Test raised an error: #" & Err.Number & " - " & Err.Description
End Sub

'@TestMethod
Public Sub AlphaIsInvalid()
    On Error GoTo TestFail

    'Arrange:
    Dim actual As Boolean
    Dim sut As New NumKeyValidator

    'Act:
    actual = sut.IsValidKeyAscii(Asc("a"), vbNullString)

    'Assert:
    Assert.IsFalse actual

TestExit:
    Exit Sub
TestFail:
    Assert.Fail "Test raised an error: #" & Err.Number & " - " & Err.Description
End Sub

'@TestMethod
Public Sub DollarSignIsInvalid()
    On Error GoTo TestFail

    'Arrange:
    Dim actual As Boolean
    Dim sut As New NumKeyValidator

    'Act:
    actual = sut.IsValidKeyAscii(Asc("$"), vbNullString)

    'Assert:
    Assert.IsFalse actual

TestExit:
    Exit Sub
TestFail:
    Assert.Fail "Test raised an error: #" & Err.Number & " - " & Err.Description
End Sub

'@TestMethod
Public Sub NegativeSignIsInvalid()
    On Error GoTo TestFail

    'Arrange:
    Dim actual As Boolean
    Dim sut As New NumKeyValidator

    'Act:
    actual = sut.IsValidKeyAscii(Asc("-"), vbNullString)

    'Assert:
    Assert.IsFalse actual

TestExit:
    Exit Sub
TestFail:
    Assert.Fail "Test raised an error: #" & Err.Number & " - " & Err.Description
End Sub

那就是说我看不出你所展示的代码如何“阻止你的用户形式中的几乎所有文本框”。

使VBA表单特定TextBox仅接受数字，也接受“。”

2 个答案: