检查复选框时出错

时间:2016-06-27 13:03:31

标签: vba excel-vba excel

我现在在Audience类别下有6个CheckBox,并且想要制作它以便他们必须选择6个CheckBox中的至少一个或者出现错误消息"请选择一个Audience"会出现。

现在使用下面的代码,仍然会输入项目,无论他们是否选中了6个方框中的一个。

我目前的代码如下:

Function CheckInputs() As Boolean
    If Not CheckControl(Me.nameTextbox, "Please enter your name") Then Exit Function
    If Not CheckControl(Me.projectTextbox, "Please enter a Project Name") Then Exit Function
    If Not CheckControl(Me.initiativeCombobox, "Please select an Initiative") Then Exit Function
    If Not CheckControl(Me.impactCombobox, "Please select Impact Type") Then Exit Function
    If Not CheckControl(Me.lengthListbox, "") Then If Not CheckControl(Me.lengthListbox2, "Please enter project length") Then Exit Function
    If Not CheckControl(Me.rvpCheckbox, "") Then If Not CheckControl(Me.umCheckbox, "") Then If Not CheckControl(Me.uwCheckbox, "") Then If Not CheckControl(Me.baCheckbox, "") Then If Not CheckControl(Me.uaCheckbox, "") Then If Not CheckControl(Me.otherCheckbox, "Please select an Audience") Then Exit Function


    CheckInputs = True
End Function

Private Function CountSelectedListBoxItems(lb As MSForms.ListBox) As Long
    Dim i As Long
    With lb
        For i = 0 To .ListCount - 1
            If .Selected(i) Then CountSelectedListBoxItems = CountSelectedListBoxItems + 1
        Next i
    End With
End Function

Function CheckControl(ctrl As MSForms.Control, errMsg As String) As Boolean
    Select Case TypeName(ctrl)
        Case "TextBox"
            CheckControl = Trim(ctrl.Value) <> ""
        Case "ComboBox"
            CheckControl = ctrl.ListIndex <> -1
        Case "ListBox"
            CheckControl = CountSelectedListBoxItems(ctrl) > 0
        Case "CheckBox"
            CheckControl = ctrl.Value = False
'        Case Else
    End Select
    If errMsg = "" Then Exit Function
    If CheckControl Then Exit Function
    ctrl.SetFocus
    MsgBox errMsg
End Function

将CheckBox的CheckControl函数设置为ctrl.Value = False是否是合适的路径?或者我没有正确设置CheckInputs功能?

1 个答案:

答案 0 :(得分:0)

是的,在我看来(如果我理解正确的话)你的Parse功能目前是不正确的。

以下代码行:

CheckInputs

需要更改为以下内容:

If Not CheckControl(Me.rvpCheckbox, "") Then If Not CheckControl(Me.umCheckbox, "") Then If Not CheckControl(Me.uwCheckbox, "") Then If Not CheckControl(Me.baCheckbox, "") Then If Not CheckControl(Me.uaCheckbox, "") Then If Not CheckControl(Me.otherCheckbox, "Please select an Audience") Then Exit Function