VBA Excel Userform проблема с флажком - PullRequest
Новая
       11

VBA Excel Userform проблема с флажком

0 голосов
/ 28 января 2019

У меня небольшая проблема, я надеюсь, вы можете помочь с этим.Я создал пользовательскую форму с набором флажков.Идея в том, что вы можете установить флажок типа фильтра / копирования / вставки, а затем нажать «ОК», и он запустится.Проблема в том, что он работает, как только вы установите флажок, а не ждать.Я уверен, что мой заказ испорчен, или мне нужно заявление if, но я не могу понять, как заставить его работать.Я включил код для кнопки, а также кнопки «ОК» и «Отмена».

Любая помощь будет признательна! 

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

    Select Case True
        Case CheckBox1.Enabled
            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
            Set rang = 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

        Case CheckBox2.Enabled
            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
            Set rang = 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

        Case CheckBox3.Enabled
            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
            Set rang = 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

        Case CheckBox4.Enabled
            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
            Set rang = 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

        Case CheckBox5.Enabled
            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
            Set rang = 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

        Case CheckBox6.Enabled
            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
            Set rang = 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
    End Select
    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 голосов
/ 28 января 2019

Вам нужно поместить свой код, который находится в событии checkbox_click, в событие кнопки OK, как показано ниже: 

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

    Select Case True
        Case CheckBox1.Value
            'Do something
        Case CheckBox2.Value
            'Do something
        Case CheckBox3.Value
            'Do something
        Case CheckBox4.Value
            'Do something
        Case CheckBox5.Value
            'Do something
        Case CheckBox6.Value
            ActiveSheet.Range("$A$1:$AE$10000").AutoFilter Field:=1, Criteria1:="NR"
            ActiveSheet.Range("$A$1:$AE$10000").AutoFilter Field:=21, Criteria1:="FALSE"

            'Output Paginated Pages (in testing)
            Set sh = Worksheets("Country")
            Set rang = sh.UsedRange.Offset(1, 0)
            On Error Resume Next
            Set rang = 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
    End Select

    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
...