vba 限制 Excel 用户窗体中的文本框条目

Restricting textbox entries in Excel UserForm

提问by MontasaurusWrex

I'm building a UserForm in Excel VBA for simple data entry (i.e. surveys). The surveys are in the basic "Strongly Disagree" to "Strongly Agree" format. Each respondent has 8 options per question ("1"-"5" for the agreement rankings, "99" for N/A, and "88" should the respondent choose not to answer). To improve the speed and accuracy of the data entry process, I need my UserForm to only allow only those integers in the textboxes.

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

I've messed around with KeyPress, but have run into some trouble with the double digit entries. Here's what I had:

我弄乱了 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

This worked alright, except that it's not perfect, in that it also allows invalid entries such as, "11" - "15", "81" - "85", and so forth. I've spent a good two weeks looking around the internet for something and haven't found anything. Surely there is a simple way to validate these textboxes the way I'm asking, but I just can't seem to figure it out. Any help would be greatly appreciated.

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

Just let me know if anyone needs more of the code. Thanks in advance for your help.

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

采纳答案by Sorceri

Just check the value after they leave the field

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

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

Here is a solution that utlizes the submit button to validate (commandbutton1), per your recent comments. In the click method it loops through the controls and checks to see if it is a textbox, if so it passes the textbox to be validated. If it fails validation it will set focus back to the control, you may wish to add a message box so the user knows that it failed.

这是一个根据您最近的评论使用提交按钮进行验证 (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

回答by Doug Glancy

If it was me, I'd use comboboxes with the choices restricted to your list. For a demo, put a couple comboboxes on a form and add this to its code:

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

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

EDIT: Added "Select One" line above per conversation in comments.

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

EDIT 2: Added sample code to distinguish between two types of ComboBoxes- cboType1 and cboType2. Name your ComboBoxes with one of these two prefixes and the code will fill them correctly. Note that there are other ways to do this, e.g., with the ComboBox's Tagproperty. The point is to be able to distinguish them in code.

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

回答by DrMarbuse

My code as extension of Doug Glancyssuggestion. The solution uses the tag-property of each of the textboxes.

我的代码是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