VBA用户窗体复选框无法识别所有选中的框

时间：2019-01-29 15:58:44

标签： excel vba userform

我已经设置了一个复选框，在您选择了复选框并单击“确定”之后，它将为每个复选框运行代码。但是它只运行第一个复选框，然后结束，而没有移至下一个... IE，如果我有NN和NC，则它将仅执行NN。

我不确定代码中缺少什么，我希望有人可以看到我没有的内容。任何帮助将不胜感激！

Private Sub CheckBox1_Click()
End Sub

Private Sub CheckBox2_Click()
End Sub

Private Sub CheckBox3_Click()
End Sub

Private Sub CheckBox4_Click()
End Sub

Private Sub CheckBox5_Click()
End Sub

Private Sub CheckBox6_Click()
 End Sub

Public Property Get IsCancelled() As Boolean
IsCancelled = cancelled
End Property

Private Sub OkButton_Click()

Dim sh As Worksheet
Dim rang As Range
Dim c As Control

For Each c In Me.Controls

If TypeOf c Is msforms.CheckBox Then

Select Case c.Name
    Case CheckBox1.Value
        'Report Paginated Pages
        ActiveSheet.Range("$A$1:$AE$10000").AutoFilter Field:=1, Criteria1:="NN"
        ActiveSheet.Range("$A$1:$AE$10000").AutoFilter Field:=21, Criteria1:="FALSE"
        Set sh = Worksheets("Country")
        Set rang = sh.UsedRange.Offset(1, 0)
        On Error Resume Next
        rang.SpecialCells(xlCellTypeVisible).Copy
        Worksheets("PPage").Activate
        Worksheets("PPage").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        Selection.Range("G1:R" & lrow).ClearContents
        Selection.Range("V1:AB" & lrow).Delete
        sh.Activate
        Application.CutCopyMode = False
        Range("A1").Select

        'Remove Working pages
        Worksheets("WPage").Activate
        ActiveSheet.Range("$A$1:$AE$10000").AutoFilter Field:=1, Criteria1:="NN"
        Set sh = Worksheets("WPage")
        Set rang = sh.UsedRange.Offset(1, 0)
        rang.SpecialCells(xlCellTypeVisible).Select
        Selection.Delete
        ActiveSheet.Range("$A$1:$AE$10000").AutoFilter Field:=1
        Worksheets("Country").Activate

    Case CheckBox2.Value
        'Report Paginated Pages
        ActiveSheet.Range("$A$1:$AE$10000").AutoFilter Field:=1, Criteria1:="NC"
        ActiveSheet.Range("$A$1:$AE$10000").AutoFilter Field:=21, Criteria1:="FALSE"
        Set sh = Worksheets("Country")
        Set rang = sh.UsedRange.Offset(1, 0)
        On Error Resume Next
        rang.SpecialCells(xlCellTypeVisible).Copy
        Worksheets("PPage").Activate
        Worksheets("PPage").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        Selection.Range("G1:R" & lrow).ClearContents
        Selection.Range("V1:AB" & lrow).Delete
        sh.Activate
        Application.CutCopyMode = False
        Range("A1").Select

        'Remove Working pages
        Worksheets("WPage").Activate
        ActiveSheet.Range("$A$1:$AE$10000").AutoFilter Field:=1, Criteria1:="NC"
        Set sh = Worksheets("WPage")
        Set rang = sh.UsedRange.Offset(1, 0)
        Set rang = rang.SpecialCells(xlCellTypeVisible).Select
        Selection.Delete
        ActiveSheet.Range("$A$1:$AE$10000").AutoFilter Field:=1
        Worksheets("Country").Activate

    Case CheckBox3.Value
        'Report Paginated Pages
        ActiveSheet.Range("$A$1:$AE$10000").AutoFilter Field:=1, Criteria1:="NF"
        ActiveSheet.Range("$A$1:$AE$10000").AutoFilter Field:=21, Criteria1:="FALSE"
        Set sh = Worksheets("Country")
        Set rang = sh.UsedRange.Offset(1, 0)
        On Error Resume Next
        rang.SpecialCells(xlCellTypeVisible).Copy
        Worksheets("PPage").Activate
        Worksheets("PPage").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        Selection.Range("G1:R" & lrow).ClearContents
        Selection.Range("V1:AB" & lrow).Delete
        sh.Activate
        Application.CutCopyMode = False
        Range("A1").Select

        'Remove Working pages
        Worksheets("WPage").Activate
        ActiveSheet.Range("$A$1:$AE$10000").AutoFilter Field:=1, Criteria1:="NF"
        Set sh = Worksheets("WPage")
        Set rang = sh.UsedRange.Offset(1, 0)
        Set rang = rang.SpecialCells(xlCellTypeVisible).Select
        Selection.Delete
        ActiveSheet.Range("$A$1:$AE$10000").AutoFilter Field:=1
        Worksheets("Country").Activate

    Case CheckBox4.Value
        'Report Paginated Pages
        ActiveSheet.Range("$A$1:$AE$10000").AutoFilter Field:=1, Criteria1:="NT"
        ActiveSheet.Range("$A$1:$AE$10000").AutoFilter Field:=21, Criteria1:="FALSE"
        Set sh = Worksheets("Country")
        Set rang = sh.UsedRange.Offset(1, 0)
        On Error Resume Next
        rang.SpecialCells(xlCellTypeVisible).Copy
        Worksheets("PPage").Activate
        Worksheets("PPage").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        Selection.Range("G1:R" & lrow).ClearContents
        Selection.Range("V1:AB" & lrow).Delete
        sh.Activate
        Application.CutCopyMode = False
        Range("A1").Select

        'Remove Working pages
        Worksheets("WPage").Activate
        ActiveSheet.Range("$A$1:$AE$10000").AutoFilter Field:=1, Criteria1:="NT"
        Set sh = Worksheets("WPage")
        Set rang = sh.UsedRange.Offset(1, 0)
        Set rang = rang.SpecialCells(xlCellTypeVisible).Select
        Selection.Delete
        ActiveSheet.Range("$A$1:$AE$10000").AutoFilter Field:=1
        Worksheets("Country").Activate

    Case CheckBox5.Value
        'Report Paginated Pages
        ActiveSheet.Range("$A$1:$AE$10000").AutoFilter Field:=1, Criteria1:="NB"
        ActiveSheet.Range("$A$1:$AE$10000").AutoFilter Field:=21, Criteria1:="FALSE"
        Set sh = Worksheets("Country")
        Set rang = sh.UsedRange.Offset(1, 0)
        On Error Resume Next
        rang.SpecialCells(xlCellTypeVisible).Copy
        Worksheets("PPage").Activate
        Worksheets("PPage").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        Selection.Range("G1:R" & lrow).ClearContents
        Selection.Range("V1:AB" & lrow).Delete
        sh.Activate
        Application.CutCopyMode = False
        Range("A1").Select

        'Remove Working pages
        Worksheets("WPage").Activate
        ActiveSheet.Range("$A$1:$AE$10000").AutoFilter Field:=1, Criteria1:="NB"
        Set sh = Worksheets("WPage")
        Set rang = sh.UsedRange.Offset(1, 0)
        Set rang = rang.SpecialCells(xlCellTypeVisible).Select
        Selection.Delete
        ActiveSheet.Range("$A$1:$AE$10000").AutoFilter Field:=1
        Worksheets("Country").Activate

    Case CheckBox6.Value
        'Report Paginated Pages
        ActiveSheet.Range("$A$1:$AE$10000").AutoFilter Field:=1, Criteria1:="NR"
        ActiveSheet.Range("$A$1:$AE$10000").AutoFilter Field:=21, Criteria1:="FALSE"
        Set sh = Worksheets("Country")
        Set rang = sh.UsedRange.Offset(1, 0)
        On Error Resume Next
        rang.SpecialCells(xlCellTypeVisible).Copy
        Worksheets("PPage").Activate
        Worksheets("PPage").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        Selection.Range("G1:R" & lrow).ClearContents
        Selection.Range("V1:AB" & lrow).Delete
        sh.Activate
        Application.CutCopyMode = False
        Range("A1").Select

        'Remove Working pages
        Worksheets("WPage").Activate
        ActiveSheet.Range("$A$1:$AE$10000").AutoFilter Field:=1, Criteria1:="NR"
        Set sh = Worksheets("WPage")
        Set rang = sh.UsedRange.Offset(1, 0)
        Set rang = rang.SpecialCells(xlCellTypeVisible).Select
        Selection.Delete
        ActiveSheet.Range("$A$1:$AE$10000").AutoFilter Field:=1
        Worksheets("Country").Activate
    Case Else
    End Select
End If
Next c
    Hide
End Sub

Private Sub CancelButton_Click()
OnCancel
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = VbQueryClose.vbFormControlMenu Then
    Cancel = True
    OnCancel
End If
End Sub

Private Sub OnCancel()
cancelled = True
Hide
End Sub

1 个答案:

答案 0 :(得分：2)

这样的事情应该是一个很好的起点

    Private Sub CommandButton1_Click()

Dim c As Control

For Each c In Me.Controls

    If TypeOf c Is msforms.CheckBox Then

    If c Then

        Select Case c.Name

            Case "CheckBox1"

                MsgBox "Checkbox 1"

            Case "CheckBox2"

                MsgBox "Checkbox 2"

            Case Else

        End Select

    End If

    End If

Next c

End Sub
相关问题
最新问题