使 VBA 表单特定的 TextBox 只接受数字和“。”

Making VBA Form specific TextBox accept Numbers only and also "."

提问by Nadine Ruttimann

I want to block some specific textboxes has numeric values only and accept ".". However, it blocks almost all my textboxes in my userform. I don't understand why. What I forgot in my code?

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

Private Sub tbxHour_Exit(ByVal Cancel As MSForms.ReturnBoolean)

'Making TextBox accept Numbers only

If Not IsNumeric(tbxHour.Value) Then
    MsgBox "only numbers allowed"
    Cancel = True
End If

End Sub

Private Sub tbxHour_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)


Select Case KeyAscii
    Case 46
        If InStr(1, tbxHour, ".") > 0 Then KeyAscii = 0
    Case 48 To 57
    Case Else
        KeyAscii = 0
End Select

End Sub

回答by jDave1984

This one worked for me:

这个对我有用：

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

Short. Simple. Effective and looks like what you're trying to do anyway.

短的。简单的。有效并且看起来就像您正在尝试做的那样。

回答by Mathieu Guindon

I use this simply NumKeyValidatorclass for that, to simply preventinvalid input to be supplied by the user:

我使用这个简单的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

You can use it by simply declaring an instance field for it:

您可以通过简单地为其声明一个实例字段来使用它：

Private validator As New NumKeyValidator

And then you use it in each textbox' KeyPresshandler, like this:

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

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

There's no need to handle Exitand pop a MsgBoxthen - either the box is empty, or it contains a valid number; you could have an IsValidFormproperty that returns Trueif all required textboxes contain numbers, and false otherwise - and then decide that the form's Okbutton is disabled until the form is valid.

不需要处理Exit和弹出MsgBoxthen - 盒子是空的，或者它包含一个有效的数字；您可以拥有一个IsValidForm属性，True如果所有必需的文本框都包含数字，则返回该属性，否则返回false - 然后决定Ok禁用表单的按钮，直到表单有效。

FWIW that validator class is quite thoroughly tested (using Rubberduckunit tests [disclaimer: I own that open-source VBE add-in project]):

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

That said I don't see how the code you've shown could ever "block almost all textboxes in your userform".

也就是说，我看不到您显示的代码如何“阻止用户表单中的几乎所有文本框”。