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

时间：2013-02-07 18:58:44

标签： excel-vba vba excel

我正在Excel VBA中构建一个UserForm，用于简单的数据输入（即调查）。这些调查基本上是“非常不同意”到“非常同意”的格式。每个受访者每个问题有8个选项（“1” - 协议排名为“5”，N / A为“99”，被访者选择不答复为“88”）。为了提高数据输入过程的速度和准确性，我需要我的UserForm只允许文本框中的那些整数。

我已经搞乱了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”等等。我花了两周的时间环顾互联网寻找一些东西并且没有找到任何东西。当然，有一种简单的方法来验证这些文本框，就像我问的那样，但我似乎无法弄明白。任何帮助将不胜感激。

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

3 个答案:

答案 0 :(得分：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。使用这两个前缀之一命名您的ComboBoxes，代码将正确填充它们。请注意，还有其他方法可以执行此操作，例如，使用ComboBox的Tag属性。关键是能够在代码中区分它们。

答案 1 :(得分：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

答案 2 :(得分：0)

我的代码是Doug Glancys建议的扩展名。 该解决方案使用每个文本框的tag-property。

''
' 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
相关问题
最新问题