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