Modify Dialog Box

[Cpinhey]

Hi, I've been using the following code for some time, but my workbook has expanded and I now have over 40 sheets which users need to be able to select from.

My question is: how do I amend this code to show checkboxes for all the sheets in the dialog box? I've tried increasing the width, but this doesn't add any additional check boxes. My workbook is likely to increase in size again, so ideally the code would accomodate the need for additional checkboxes in the future.

For info - I am using excel 2007. Any help would be much appreciated.

Sub SelectSheets()
' John Walkenbach
' www.j-walk.com
Dim i As Integer
Dim TopPos As Integer
Dim SheetCount As Integer
Dim PrintDlg As DialogSheet
Dim CurrentSheet As Worksheet, FinalSheet As Worksheet
Dim cb As CheckBox
Application.ScreenUpdating = False
Set FinalSheet = ActiveSheet

' Check for protected workbook
If ActiveWorkbook.ProtectStructure Then
MsgBox "Workbook is protected.", vbCritical
Exit Sub
End If
' Add a temporary dialog sheet
Set CurrentSheet = ActiveSheet
Set PrintDlg = ActiveWorkbook.DialogSheets.Add
SheetCount = 0
' 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
PrintDlg.CheckBoxes.Add 100, TopPos, 150, 16.5
PrintDlg.CheckBoxes(SheetCount).Text = _
CurrentSheet.Name 'CurrentSheet.Name
TopPos = TopPos + 13
End If
Next i
' Move the OK and Cancel buttons
PrintDlg.Buttons.Left = 200
' Set dialog height, width, and caption
With PrintDlg.DialogFrame
.Height = Application.Max _
(68, PrintDlg.DialogFrame.Top + TopPos - 80)
.Width = 500
.Caption = "Select sheets to print"
End With
' Change tab order of OK and Cancel buttons
' so the 1st option button will have the focus
PrintDlg.Buttons("Button 2").BringToFront
PrintDlg.Buttons("Button 3").BringToFront

' Display the dialog box
CurrentSheet.Activate
Application.ScreenUpdating = True
If SheetCount <> 0 Then
If PrintDlg.Show Then
For Each cb In PrintDlg.CheckBoxes
If cb.Value = xlOn Then
Worksheets(cb.Caption).Activate
ActiveSheet.PrintOut
' ActiveSheet.PrintPreview 'for debugging
End If
Next cb
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
FinalSheet.Activate
End Sub

 

[Cpinhey]

If I didn't make myself clear, the problem is the current code only shows a checkbox for the first 30 sheets and I would like to show checkboxes for all sheets in the workbook.

 

[djreiswig]

Looks like a good place for a userform with a multiselect option style listbox.

 

[Cpinhey]

I had thought of using listbox, but ideally, I'd like to keep the check box and temp dialog box as I don't want to clutter up an already busy "print reports" sheet with a further object. Plus there are multiple users of the workbook and I've found in the past users have an ability to mess up things without even trying.

Is there any way to show say 2 or 3 columns of checkboxes showing all worksheets in the workbook in the temp dialog box?

 

[djreiswig]

You wouldn't have to clutter up your sheet if you made a userform with a listbox pop up over the sheet and then go away after you were done selecting the sheets. I think that would look much neater than a bunch of check boxes on a sheet. Also would be much easier to add to in the future.

 

[Cpinhey]

Looks like I'll have to use the list box.

 

[djreiswig]

Okay, since you seem set on using checkboxes, I took a look at your code and here is what I came up with. You can change the number of boxes in a column to make them show up they way you want. You could probably come up with some sort of calculation to make this automatic, but this will at least show a box for each sheet in columns.

Sub SelectSheets()
    ' John Walkenbach
    ' www.j-walk.com
    Dim i As Integer
    Dim TopPos As Integer
    Dim LeftPos As Integer
    Dim SheetCount As Integer
    Dim PrintDlg As DialogSheet
    Dim CurrentSheet As Worksheet, FinalSheet As Worksheet
    Dim cb As CheckBox
    Const BoxesInCol = 5
    
    Application.ScreenUpdating = False
    Set FinalSheet = ActiveSheet
    
    ' Check for protected workbook
    If ActiveWorkbook.ProtectStructure Then
        MsgBox "Workbook is protected.", vbCritical
    Exit Sub
    End If
    ' Add a temporary dialog sheet
    Set CurrentSheet = ActiveSheet
    Set PrintDlg = ActiveWorkbook.DialogSheets.Add
    SheetCount = 0
    ' Add the checkboxes
    TopPos = 40
    LeftPos = 100
    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
            PrintDlg.CheckBoxes.Add LeftPos, TopPos, 150, 16.5
            PrintDlg.CheckBoxes(SheetCount).Text = _
            CurrentSheet.Name 'CurrentSheet.Name
            TopPos = TopPos + 13
            'move to next column
            If i Mod BoxesInCol = 0 Then
                LeftPos = LeftPos + 150
                TopPos = 40
            End If
        End If
    Next i
    ' Set dialog height, width, and caption
    With PrintDlg.DialogFrame
        .Height = BoxesInCol * 16.5 + 20
        .Width = Application.WorksheetFunction.RoundUp((i - 1) / BoxesInCol, 0) * 150 + 100
        .Caption = "Select sheets to print"
    End With
    ' Move the OK and Cancel buttons
    PrintDlg.Buttons.Left = PrintDlg.DialogFrame.Width
    ' Change tab order of OK and Cancel buttons
    ' so the 1st option button will have the focus
    PrintDlg.Buttons("Button 2").BringToFront
    PrintDlg.Buttons("Button 3").BringToFront
    
    ' Display the dialog box
    CurrentSheet.Activate
    Application.ScreenUpdating = True
    If SheetCount <> 0 Then
        If PrintDlg.Show Then
            For Each cb In PrintDlg.CheckBoxes
                If cb.Value = xlOn Then
                    Worksheets(cb.Caption).Activate
                    ActiveSheet.PrintOut
                    'ActiveSheet.PrintPreview 'for debugging
                End If
            Next cb
        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
    FinalSheet.Activate
End Sub

 

[Cpinhey]

Many thanks for your help, I've also created a multiselect list box like you suggested, both work perfectly. It's good that I have 2 options to take to my (excel illiterate) boss.

I'm guessing this code will also be good for selecting which sheets to save to pdf with some minor modifications. A job for monday morning I think!

thanks again.