Small ammendment please help

[robhargreaves]

Hi,

I have some 'very new to IT users' using my spreadsheet and so have found the following code to allow for a dialogue box to pop up from the click of a button allowing the user to select any sheet from the workbook and to print it

Sub Print_Sheets()

 Dim i As Integer
    Dim TopPos As Integer
    Dim SheetCount As Integer
    Dim PrintDlg As DialogSheet
    Dim CurrentSheet
    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
    Set CurrentSheet = ActiveSheet
    Set PrintDlg = ActiveWorkbook.DialogSheets.Add

    SheetCount = 0

'   Add the checkboxes
    TopPos = 40
    For i = 1 To ActiveWorkbook.Sheets.Count
        Set CurrentSheet = ActiveWorkbook.Sheets(i)
'       Skip empty sheets and hidden sheets
        If CurrentSheet.Visible Then
            SheetCount = SheetCount + 1
            PrintDlg.CheckBoxes.Add 78, TopPos, 150, 16.5
                PrintDlg.CheckBoxes(SheetCount).Text = _
                    CurrentSheet.Name
            TopPos = TopPos + 13
        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 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
                    Sheets(cb.Caption).Activate
                    ActiveSheet.PrintOut , (1)
'                   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
      Application.Goto Reference:=Worksheets("Menu").Range("A1")

End Sub

I am happy with the code although I would like to know how to name some sheets to leave out of the list.

Can anyone help?

I know I will have to set them out in the loop creating the checkboxes for each sheet but dont know how.

Many Thanks

Rob

 

[HalfAce]

Hi Rob,
How many sheets are there that you want to exclude?
If there are only a few, and their names are already known, you might try something like this:

In the Add to checkboxes section, right below the comment "Skip empty sheets and hidden sheets", replace the line:
If CurrentSheet.Visible Then
with
If CurrentSheet.Visible _
And CurrentSheet.Name <> "JoeBob" _
And CurrentSheet.Name <> "BillyBob" Then

Hope it helps,
Dan

 

[Whisperer14]

Could you not hide them? failing that put a couple of distinctive letters in front of the name "XXName" and then check for Left(Activesheet.Name,2)

 

[robhargreaves]

It has worked fine, thanks guys !!
Rob

 

[Whisperer14]

Rob,
I note that the dialog box itself is one of the options to be printed....

 

[HalfAce]

Here's another option, adapted from something Ivan Moala originally wrote.
It uses a listbox instead of the checkboxes, doesn't include the diolog sheet, and looks suspiciously lol like what the OP is using. (Can be amended to exclude named sheets just like above.)

Sub SelectSheetsToPrint()
Dim i As Integer
    Dim TopPos As Integer
    Dim SheetCount As Integer
    Dim PrintDlg As DialogSheet
    Dim sh As Worksheet, _
        CurrentSheet As Worksheet
    Dim cb As Long
    Dim Cht()
    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
    Set sh = ActiveSheet
    Set PrintDlg = ActiveWorkbook.DialogSheets.Add

    SheetCount = 0

'   Add the checkboxes
    TopPos = 40
    PrintDlg.ListBoxes.Add 78, TopPos, 150, 100
    PrintDlg.ListBoxes.MultiSelect = xlSimple
    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.ListBoxes.AddItem CurrentSheet.Name
            ReDim Preserve Cht(1, SheetCount)
            Cht(0, SheetCount) = CurrentSheet.Name
            TopPos = TopPos + 13
        End If
    Next i

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

'   Set dialog height, width, and caption
    With PrintDlg.DialogFrame
        .Height = 140
        .Width = 230
        .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
    sh.Activate
    Application.ScreenUpdating = True
    If SheetCount <> 0 Then
        If PrintDlg.Show Then
            For cb = 1 To SheetCount
                If PrintDlg.ListBoxes.Selected(cb) = True Then
                    Sheets(Cht(0, cb)).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 the sheet of choice
   Worksheets("Menu").Activate
End Sub

Dan