dialog issue - sheets to print checkboxes

S

sgkessel

New Member
Joined
Feb 7, 2012
Messages
15
I found a very helpful piece of code that generates a "sheets to print" check box menu so I can specify what sheets to print as shown in this example pic:
http://spreadsheetpage.com/graphics/tips/prsheet.gif

but for whatever reason, the very last active sheet is printed whether or not I click the box... so based on the example, I would get a single PDF print including the 3 tabs that are checked, and the last tab "Sheet 2" even though it's not chosen.
kinda defeats the purpose of the check boxes if I don't get just what I click on!

Please help!
here is my code:

Option Explicit

Sub Print_Workbook()

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

End Sub
 

Excel Facts

Repeat Last Command
Pressing F4 adds dollar signs when editing a formula. When not editing, F4 repeats last command.
Sort by date Sort by votes
Try this,
Code: 
[FONT="Consolas"][SIZE="2"][COLOR="Navy"]Option Explicit

Sub Print_Workbook()

    Dim i As Integer
    Dim TopPos As Integer
    Dim SheetCount As Integer
    Dim PrintDlg As DialogSheet
    Dim CurrentSheet As Worksheet
    Dim Wsh As Worksheet
    Dim cb As CheckBox

    Application.ScreenUpdating = False

[COLOR="Green"]    ' Check for protected workbook[/COLOR]
    If ActiveWorkbook.ProtectStructure Then
        MsgBox "Workbook is protected.", vbCritical
        Exit Sub
    End If

[COLOR="Green"]    ' Add a temporary dialog sheet[/COLOR]
    Set CurrentSheet = ActiveSheet
    Set PrintDlg = ActiveWorkbook.DialogSheets.Add

    SheetCount = 0

[COLOR="Green"]    ' Add the checkboxes[/COLOR]

    TopPos = 40
    For Each Wsh In ActiveWorkbook.Worksheets
[COLOR="Green"]        ' Skip empty sheets and hidden sheets[/COLOR]
        If Application.CountA(Wsh.Cells) <> 0 And Wsh.Visible Then
            SheetCount = SheetCount + 1
            PrintDlg.CheckBoxes.Add 78, TopPos, 150, 16.5
            PrintDlg.CheckBoxes(SheetCount).Text = Wsh.Name
            TopPos = TopPos + 13
        End If
    Next Wsh

[COLOR="Green"]    ' Move the OK and Cancel buttons[/COLOR]
    PrintDlg.Buttons.Left = 240

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

[COLOR="Green"]    ' Change tab order of OK and Cancel buttons
    ' so the 1st option button will have the focus[/COLOR]
    PrintDlg.Buttons("Button 2").BringToFront
    PrintDlg.Buttons("Button 3").BringToFront

[COLOR="Green"]    ' Display the dialog box[/COLOR]
    CurrentSheet.Activate
    If SheetCount <> 0 Then
        If PrintDlg.Show Then
[COLOR="Green"]            '* Re-use SheetCount as flag [1= 1st sheet, 2=Other sheets][/COLOR]
            SheetCount = 1
            For Each cb In PrintDlg.CheckBoxes
                If cb.Value = xlOn Then
                    Worksheets(cb.Caption).Select Replace:=SheetCount = 1
                    SheetCount = 2
                End If
            Next cb
            ActiveWindow.SelectedSheets.PrintOut Copies:=1
        End If
    Else
        MsgBox "All worksheets are empty."
    End If

[COLOR="Green"]    ' Delete temporary dialog sheet (without a warning)[/COLOR]
    Application.DisplayAlerts = False
    PrintDlg.Delete
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

[COLOR="Green"]    ' Reactivate original sheet[/COLOR]
    CurrentSheet.Activate

End Sub[/COLOR][/SIZE][/FONT]
 
Upvote 0
Mohammad Basem said:
Try this,
Code: 
[FONT="Consolas"][SIZE="2"][COLOR="Navy"]Option Explicit

Sub Print_Workbook()

    Dim i As Integer
    Dim TopPos As Integer
    Dim SheetCount As Integer
    Dim PrintDlg As DialogSheet
    Dim CurrentSheet As Worksheet
    Dim Wsh As Worksheet
    Dim cb As CheckBox

    Application.ScreenUpdating = False

[COLOR="Green"]    ' Check for protected workbook[/COLOR]
    If ActiveWorkbook.ProtectStructure Then
        MsgBox "Workbook is protected.", vbCritical
        Exit Sub
    End If

[COLOR="Green"]    ' Add a temporary dialog sheet[/COLOR]
    Set CurrentSheet = ActiveSheet
    Set PrintDlg = ActiveWorkbook.DialogSheets.Add

    SheetCount = 0

[COLOR="Green"]    ' Add the checkboxes[/COLOR]

    TopPos = 40
    For Each Wsh In ActiveWorkbook.Worksheets
[COLOR="Green"]        ' Skip empty sheets and hidden sheets[/COLOR]
        If Application.CountA(Wsh.Cells) <> 0 And Wsh.Visible Then
            SheetCount = SheetCount + 1
            PrintDlg.CheckBoxes.Add 78, TopPos, 150, 16.5
            PrintDlg.CheckBoxes(SheetCount).Text = Wsh.Name
            TopPos = TopPos + 13
        End If
    Next Wsh

[COLOR="Green"]    ' Move the OK and Cancel buttons[/COLOR]
    PrintDlg.Buttons.Left = 240

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

[COLOR="Green"]    ' Change tab order of OK and Cancel buttons
    ' so the 1st option button will have the focus[/COLOR]
    PrintDlg.Buttons("Button 2").BringToFront
    PrintDlg.Buttons("Button 3").BringToFront

[COLOR="Green"]    ' Display the dialog box[/COLOR]
    CurrentSheet.Activate
    If SheetCount <> 0 Then
        If PrintDlg.Show Then
[COLOR="Green"]            '* Re-use SheetCount as flag [1= 1st sheet, 2=Other sheets][/COLOR]
            SheetCount = 1
            For Each cb In PrintDlg.CheckBoxes
                If cb.Value = xlOn Then
                    Worksheets(cb.Caption).Select Replace:=SheetCount = 1
                    SheetCount = 2
                End If
            Next cb
            ActiveWindow.SelectedSheets.PrintOut Copies:=1
        End If
    Else
        MsgBox "All worksheets are empty."
    End If

[COLOR="Green"]    ' Delete temporary dialog sheet (without a warning)[/COLOR]
    Application.DisplayAlerts = False
    PrintDlg.Delete
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

[COLOR="Green"]    ' Reactivate original sheet[/COLOR]
    CurrentSheet.Activate

End Sub[/COLOR][/SIZE][/FONT]
Click to expand...

You wonderful human being!!!
SCORE AGAIN
Two fixes from MrExcel.com in less than 24 hours and into a weekend!
Love you Guys! Keep up the fantastic work!
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question
Excel VB Organogram
Replies
1
Views
103
anuradhagrewal
A
Agnarr
  • Solved
Checkbox Timestamp with VBA
Replies
3
Views
249
bobsan42
bobsan42
I
  • Solved
Print sheets based on checkbox
Replies
3
Views
226
John_w
J
G
  • Question
Activex Check Box VBA Code not working automatically
Replies
6
Views
289
ganeshadu
G
R
  • Solved
Programmatically and Dynamically Adding/Deleting Checkboxes to Sheet
Replies
5
Views
556
rasinc
R

Forum statistics

Threads
1,215,455
Messages
6,124,938
Members
449,197
Latest member
k_bs

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top