jeudi 22 octobre 2015

Select all checkboxes on a userform, using a button

I have found and adjusted a macro to create an userform that displays all active worksheets in my workbook. The user can select all the sheets he / she wants to print. Clicking the OK button will print all the selected sheets. I changed this macro so by default it will select the sheets that are most common to be printed (if there is a "yes" in cell B98 of the sheet).

Now I'm trying to create a "select all" button and a "unselect all" button. On Click, the button calls the Sub Select_All (). I thought I could just tell the Sub Select_All() to change the status of all the checkboxes in my active workbook. Unfortunately it gives me:

Run-time error '438':

Object doesn't support this property or method

The code that creates the userform:

Sub PrintSelectedSheets()

Dim I As Integer
Dim TopPos As Integer
Dim SheetCount As Integer
Dim PrintDlg As DialogSheet
Dim CurrentSheet As Worksheet
Dim CB As CheckBox

Application.ScreenUpdating = False

'Check for protected workbook
If ActiveWorkbook.ProtectStructure Then
    MsgBox "Workbook is protected.", vbCritical
    Exit Sub
End If

'Add a temporary dialog sheet
Sheets("Cover").Select
Set CurrentSheet = ActiveSheet
Set PrintDlg = ActiveWorkbook.DialogSheets.Add

SheetCount = 0

'Add a select all button
ActiveSheet.Buttons.Add(273, 95, 52.5, 16).Select
Selection.Characters.Text = "Select All"
Selection.OnAction = "Select_All"

'Add a unselect all button
ActiveSheet.Buttons.Add(273, 116, 52.5, 16).Select
Selection.Characters.Text = "Unselect All"
Selection.OnAction = "Unselect_All"

'Add the checkboxes
TopPos = 40
For I = 1 To ActiveWorkbook.Worksheets.Count
    Set CurrentSheet = ActiveWorkbook.Worksheets(I)

'Skip empty sheets and hidden sheets
    If Application.CountA(CurrentSheet.Cells) <> 0 And _
        CurrentSheet.Visible Then
        SheetCount = SheetCount + 1
        'Change status for all checkboxes to on if B98 = yes
        If CurrentSheet.Range("B98") = "yes" Then
            PrintDlg.CheckBoxes.Add 78, TopPos, 150, 16.5
            PrintDlg.CheckBoxes(SheetCount).Value = xlOn
            PrintDlg.CheckBoxes(SheetCount).Text = CurrentSheet.Name
            TopPos = TopPos + 13
        Else
            PrintDlg.CheckBoxes.Add 78, TopPos, 150, 16.5
            PrintDlg.CheckBoxes(SheetCount).Value = xlOff
            PrintDlg.CheckBoxes(SheetCount).Text = CurrentSheet.Name
            TopPos = TopPos + 13
        End If
    End If
Next I

'Move the OK and Cancel buttons
PrintDlg.Buttons.Left = 240

'Set dialog height, width, and caption
With PrintDlg.DialogFrame
    .Height = Application.Max _
        (68, PrintDlg.DialogFrame.Top + TopPos - 34)
    .Width = 230
    .Caption = "Select sheets to print"
End With

'Change focus to the 1st option button
PrintDlg.Buttons("Button 4").BringToFront
PrintDlg.Buttons("Button 5").BringToFront

'Display the dialog box
Sheets("Cover").Activate
If SheetCount <> 0 Then
    If PrintDlg.Show Then
            For Each CB In PrintDlg.CheckBoxes
                If CB.Value = xlOn Then
                    Worksheets(CB.Caption).Select Replace:=False
                End If
            Next CB
            ActiveWindow.SelectedSheets.PrintOut copies:=1
            ActiveSheet.Select
    End If
Else
    MsgBox "All worksheets are empty."
End If

'Delete temporary dialog sheet (without a warning)
Application.DisplayAlerts = False
PrintDlg.Delete

'Reactivate original sheet
Sheets("Cover").Activate

Application.ScreenUpdating = True

End Sub

And the code that's called by clicking the Select All button: Sub Select_All()

Dim CB As CheckBox

For Each CB In ActiveWorkbook
    CB.Value = xlOn
Next CB

End Sub

I've search this site and others and tried a lot of other options, but I just can't get this to work.

Any help is really appreciated.

Thanks in advance.




Aucun commentaire:

Enregistrer un commentaire