使VBA表格特定的TextBox只接受数字,也是“。”

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

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 

这个为我工作:

 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 

短。 简单。 有效,看起来像你正在尝试做什么。

我使用这个简单的NumKeyValidator类来简单地防止用户提供的无效input:

 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并popup一个MsgBox然后 – 无论是框是空的,或者它包含一个有效的数字; 如果所有必需的文本框都包含数字,则可以返回TrueIsValidForm属性,否则返回false,然后决定窗体的Okbutton被禁用,直到表单有效。

FWIWvalidation器类是相当彻底的testing(使用Rubberduckunit testing[免责声明:我拥有该开源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 

这就是说,我看不出你所显示的代码能够“阻止你的用户表单中几乎所有的文本框”。