1

我正在 Excel VBA 中为简单的数据输入（即调查）构建一个用户窗体。调查采用基本的“非常不同意”到“非常同意”格式。每个受访者每个问题有 8 个选项（“1”-“5”表示一致性排名，“99”表示不适用，“88”表示受访者选择不回答）。为了提高数据输入过程的速度和准确性，我需要我的用户窗体只允许文本框中的那些整数。

我搞砸了 KeyPress，但在输入两位数时遇到了一些麻烦。这是我所拥有的：

Private Sub textbox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Select Case KeyAscii
    Case Asc("1") To Asc ("5")
    Case Asc("88")
    Case Asc("99")
    Case Else
        KeyAscii = 0
End Select
End Sub

这没问题，只是它并不完美，因为它还允许无效条目，例如“11”-“15”、“81”-“85”等等。我花了整整两个星期在互联网上寻找一些东西，但没有找到任何东西。当然，有一种简单的方法可以按照我的要求验证这些文本框，但我似乎无法弄清楚。任何帮助将不胜感激。

如果有人需要更多代码，请告诉我。在此先感谢您的帮助。

4

3 回答 3

2

如果是我，我会使用组合框，其选项仅限于您的列表。对于演示，在表单上放置几个组合框并将其添加到其代码中：

Private Sub UserForm_Activate()
Dim ctl As MSForms.Control
Dim cbo As MSForms.ComboBox
Dim i As Long

For Each ctl In Me.Controls
    If TypeOf ctl Is MSForms.ComboBox Then
        Set cbo = ctl
        With cbo
            .MatchRequired = True
            .Style = fmStyleDropDownList
            .AddItem "Select One"

            For i = 1 To 5
                .AddItem i
            Next i
            If Left(.Name,8)="cboType2" then
                For i = 6 To 10
                    .AddItem i
                Next i
             End If
            .AddItem 88
            If Left(.Name,8)="cboType1" then                
                 .AddItem 99
             End If

            .ListIndex = 0
        End With
    End If
Next ctl
End Sub

编辑：在评论中的每个对话上方添加了“选择一个”行。

编辑 2：添加示例代码以区分两种类型ComboBoxes- cboType1 和 cboType2。使用这两个前缀之一命名您的组合框，代码将正确填充它们。请注意，还有其他方法可以做到这一点，例如，使用 ComboBox 的Tag属性。关键是能够在代码中区分它们。

于 2013-02-07T19:28:42.787 回答
1

他们离开现场后只需检查值

Private Sub textbox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    Dim sValue As String
    Dim bInvalid As Boolean
    bInvalid = True
    sValue = Trim(Me.textbox1.Text)
    If sValue = "1" Or sValue = "2" Or sValue = "3" Or sValue = "4" Or sValue = "5" Or sValue = "99" Or sValue = "88" Then
        bInvalid = False
    End If
    If bInvalid Then
        MsgBox "Please enter a valid value"
    End If
End Sub

根据您最近的评论，这是一个使用提交按钮进行验证的解决方案（commandbutton1）。在 click 方法中，它循环遍历控件并检查它是否是文本框，如果是，则传递要验证的文本框。如果验证失败，它会将焦点设置回控件，您可能希望添加一个消息框，以便用户知道它失败了。

Private Sub CommandButton1_Click()
Dim cntrol As Control
'loop through all the controls
For Each cntrol In Me.Controls
    'check to see if it is a textbox
    If TypeOf cntrol Is MSForms.TextBox Then
        Dim tBox As MSForms.TextBox
        Set tBox = cntrol
        'we have a textbox so validate the entry
        If validateTextBox(tBox) Then
            'did not validate so set focus on the control
            'HERE IS WHERE YOU MAY WISH TO PROVIDE A MESSAGE TO THE USER
            cntrol.SetFocus
            'release the object
            Set tBox = Nothing
            'exit as we do not need to process further
            Exit Sub
        End If
        Set tBox = Nothing
    End If
Next
End Sub




'validate a textbox's value and return true or false
Private Function validateTextBox(tb As MSForms.TextBox) As Boolean
    Dim sValue As String
    Dim bInvalid As Boolean
    bInvalid = True
    sValue = Trim(tb.Text)
    If sValue = "1" Or sValue = "2" Or sValue = "3" Or sValue = "4" Or sValue = "5" Or sValue = "99" Or sValue = "88" Then
        bInvalid = False
    End If
    'return the results
    validateTextBox = bInvalid
End Function
于 2013-02-07T19:19:13.087 回答
0

我的代码作为Doug Glancys建议的扩展。该解决方案使用每个文本框的标记属性。

''
' Validate all textboxes in the userform
'
Private Sub Validate()
    Dim cntrol As Control
    Dim msgText As String

    'loop through all the controls
    For Each cntrol In Me.Controls
        'check to see if it is a textbox
        If TypeOf cntrol Is MSForms.TextBox Then
            Dim tBox As MSForms.TextBox
            Set tBox = cntrol
            'we have a textbox so validate the entry
            If validateTextBox(tBox, msgText) Then
                ' did not validate so set focus on the control
                ' select control
                selectControl cntrol
                MsgBox msgText, vbCritical + vbOKOnly, "Invalid Data"
                'release the object
                Set tBox = Nothing
                'exit as we do not need to process further
                Exit Sub
            End If
            Set tBox = Nothing
        End If
    Next
End Sub

''
' validate a textbox's value and return true or false
'
' tb is a textbox control
' msgText is a return variable holding the message text
'
Private Function validateTextBox(tb As MSForms.TextBox, Optional ByRef msgText As Variant) As Boolean

    ' constants for tag-information
    Const TAG_VALIDATE_OPEN = "[validate:"
    Const TAG_VALIDATE_CLOSE = "]"
    Const TAG_VALIDATE_DATA_OPEN = "{"
    Const TAG_VALIDATE_DATA_CLOSE = "}"

    ' variables
    Dim sValue As String
    Dim isValid As Boolean
    Dim pos1 As Long
    Dim pos2 As Long
    Dim vSpec As String
    Dim VSpecData() As String
    Dim VSpecDataDefined As Boolean
    VSpecDataDefined = False

    isValid = False
    sValue = Trim(tb.text)

    '
    ' analyse tag-string and get specifications.
    ' Syntax for tag is [validate:command{data1,data2,data3}]
    '
    pos1 = InStr(1, LCase(tb.Tag), LCase(TAG_VALIDATE_OPEN))
    If pos1 > 0 Then
        pos2 = InStr(pos1 + Len(TAG_VALIDATE_OPEN), tb.Tag, TAG_VALIDATE_CLOSE)
        vSpec = Mid(tb.Tag, pos1 + Len(TAG_VALIDATE_OPEN), pos2 - (pos1 + Len(TAG_VALIDATE_OPEN)))

        pos1 = InStr(1, vSpec, TAG_VALIDATE_DATA_OPEN)
        If pos1 > 0 Then
            pos2 = InStr(pos1, vSpec, TAG_VALIDATE_DATA_CLOSE)
            VSpecDataDefined = True
            VSpecData = Split(Mid(vSpec, pos1 + Len(TAG_VALIDATE_DATA_OPEN), pos2 - (pos1 + Len(TAG_VALIDATE_DATA_OPEN))), ",")
            vSpec = Left(vSpec, pos1 - 1)
        End If
    End If

    '
    ' Handle validation as specified
    '
    Select Case vSpec
        Case "numeric"
            If VSpecDataDefined Then
                On Error Resume Next
                Dim d As Double
                Dim dLower As Double
                Dim dUpper As Double

                d = CDbl(sValue)
                If Err.number <> 0 Then
                    isValid = False
                Else
                    msgText = "Zahl"
                    isValid = True
                    ' lower bound
                    If UBound(VSpecData) >= 0 Then
                        Select Case VSpecData(0)
                            Case "", "inf", "-inf"
                            Case Else
                                dLower = CDbl(VSpecData(0))
                                msgText = msgText & vbcrlf & "     >= " & dLower
                                isValid = isValid And d >= dLower
                        End Select
                    End If
                    ' upper bound
                    If UBound(VSpecData) >= 1 Then
                        Select Case VSpecData(0)
                            Case "", "inf", "-inf"
                            Case Else
                                dUpper = CDbl(VSpecData(1))
                                msgText = msgText & vbcrlf & "     <= " & dUpper
                                isValid = isValid And d <= dUpper
                        End Select
                    End If
                End If
            Else
                msgText = "Zahl"
                isValid = IsNumeric(sValue)
            End If

        Case Else
            isValid = True
    End Select

    '
    ' return :  true if invalid
    '           false if valid
    '
    validateTextBox = Not isValid

End Function

''
' common function to select a textbox and set focus to it
' even if it sits on a page of a multipage control
'
Private Sub selectControl(ByRef t As Control)
    On Error Resume Next
    With t
        .SelStart = 0
        .SelLength = Len(.text)
        .SetFocus
        Dim p
        Err.Clear
        Set p = t.Parent
        If Err.number <> 0 Then Set p = Nothing
        Do While Not p Is Nothing
            Err.Clear
            If typename(p) = "Page" Then
                p.Parent.value = p.index
            End If
            Err.Clear
            Set p = p.Parent
            If Err.number <> 0 Then Set p = Nothing
        Loop
    End With
    On Error GoTo 0
End Sub
于 2015-07-25T10:31:36.910 回答