Macro to Print Selected Tabs is Always Including the Last Tab

N

nobles6

New Member
Joined
May 26, 2015
Messages
5
With the help of a previous response that someone else posted on this forum, I made a macro button that creates a dialog box which allows me to select specific tabs to print as one single job. However, there is a slight error in the code in that the last tab of the workbook keeps being included in the print job even when I have not selected it. Could someone tell me what is causing this and how to fix it? Thanks for your help!

Sub Print_Sheets_Dialog_v2()

Application.Dialogs(xlDialogPrinterSetup).Show
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
Dim Hor As Integer 'this will be for the horizontal position of the items
Hor = 70
Dim wd As Integer 'this will be for the overall width of the dialog box
wd = 240
TopPos = 35
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
If SheetCount = 30 Then
Hor = 223
wd = 380
TopPos = 35
End If
PrintDlg.CheckBoxes.Add Hor, TopPos, 145, 16.5
PrintDlg.CheckBoxes(SheetCount).Text = _
CurrentSheet.Name
TopPos = TopPos + 13
End If
Next i
' Set dialog height, width, and caption
With PrintDlg.DialogFrame
.Height = 415
'.Height = Application.Max _
'(68, PrintDlg.DialogFrame.Top + TopPos)
.Width = wd
.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
' For Printing all selected sheets in one print job
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
' ActiveSheet.PrintPreview 'for debugging
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

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December
Sort by date Sort by votes
Because you use the line

Worksheets(cb.Caption).Select Replace:=False

everything is added to the selection before the code runs, i.e. the ActiveSheet.

Try the following on a copy of your workbook. I haven't tested this as I don't have your forms or structure but it simply sends each sheet that is checked in the form to the printer as soon as it is found in the loop.

Code: 
Sub Print_Sheets_Dialog_v3()

Application.Dialogs(xlDialogPrinterSetup).Show
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
Dim Hor As Integer 'this will be for the horizontal position of the items
Hor = 70
Dim wd As Integer 'this will be for the overall width of the dialog box
wd = 240
TopPos = 35
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
If SheetCount = 30 Then
Hor = 223
wd = 380
TopPos = 35
End If
PrintDlg.CheckBoxes.Add Hor, TopPos, 145, 16.5
PrintDlg.CheckBoxes(SheetCount).Text = _
CurrentSheet.Name
TopPos = TopPos + 13
End If
Next i
' Set dialog height, width, and caption
With PrintDlg.DialogFrame
.Height = 415
'.Height = Application.Max _
'(68, PrintDlg.DialogFrame.Top + TopPos)
.Width = wd
.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
' For Printing all selected sheets in one print job
If PrintDlg.Show Then
    For Each cb In PrintDlg.CheckBoxes
        If cb.Value = xlOn Then
            Worksheets(cb.Caption).PrintOut copies:=1
        End If
    Next cb
End If
' ActiveSheet.PrintPreview 'for debugging
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
 
Upvote 0
Thanks for your response. However, my goal is to select specific tabs and have them print as ONE single job and not separately/one at a time. Unfortunately, the edit your provided prints them one at a time. Is there any way to group the selected tabs in a single print without automatically including the active sheet?

Teeroy said:
Because you use the line

Worksheets(cb.Caption).Select Replace:=False

everything is added to the selection before the code runs, i.e. the ActiveSheet.

Try the following on a copy of your workbook. I haven't tested this as I don't have your forms or structure but it simply sends each sheet that is checked in the form to the printer as soon as it is found in the loop.

Code: 
Sub Print_Sheets_Dialog_v3()

Application.Dialogs(xlDialogPrinterSetup).Show
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
Dim Hor As Integer 'this will be for the horizontal position of the items
Hor = 70
Dim wd As Integer 'this will be for the overall width of the dialog box
wd = 240
TopPos = 35
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
If SheetCount = 30 Then
Hor = 223
wd = 380
TopPos = 35
End If
PrintDlg.CheckBoxes.Add Hor, TopPos, 145, 16.5
PrintDlg.CheckBoxes(SheetCount).Text = _
CurrentSheet.Name
TopPos = TopPos + 13
End If
Next i
' Set dialog height, width, and caption
With PrintDlg.DialogFrame
.Height = 415
'.Height = Application.Max _
'(68, PrintDlg.DialogFrame.Top + TopPos)
.Width = wd
.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
' For Printing all selected sheets in one print job
If PrintDlg.Show Then
    For Each cb In PrintDlg.CheckBoxes
        If cb.Value = xlOn Then
            Worksheets(cb.Caption).PrintOut copies:=1
        End If
    Next cb
End If
' ActiveSheet.PrintPreview 'for debugging
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
Click to expand...
 
Upvote 0
OK since having one print job is a requirement try the following. It will select the first sheet checked without "Replace:= False" then use that argument for future selections. This should exclude the ActiveSheet from the selection.

Code: 
Sub Print_Sheets_Dialog_v4()

Application.Dialogs(xlDialogPrinterSetup).Show
Dim i As Integer
Dim TopPos As Integer
Dim SheetCount As Integer
Dim PrintDlg As DialogSheet
Dim CurrentSheet As Worksheet
Dim cb As CheckBox
Dim bFirstSheet As Boolean

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
Dim Hor As Integer 'this will be for the horizontal position of the items
Hor = 70
Dim wd As Integer 'this will be for the overall width of the dialog box
wd = 240
TopPos = 35
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
If SheetCount = 30 Then
Hor = 223
wd = 380
TopPos = 35
End If
PrintDlg.CheckBoxes.Add Hor, TopPos, 145, 16.5
PrintDlg.CheckBoxes(SheetCount).Text = _
CurrentSheet.Name
TopPos = TopPos + 13
End If
Next i
' Set dialog height, width, and caption
With PrintDlg.DialogFrame
.Height = 415
'.Height = Application.Max _
'(68, PrintDlg.DialogFrame.Top + TopPos)
.Width = wd
.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
' For Printing all selected sheets in one print job
If PrintDlg.Show Then
bFirstSheet = True
For Each cb In PrintDlg.CheckBoxes
If cb.Value = xlOn Then
    If bFirstSheet Then
        Worksheets(cb.Caption).Select
        bFirstSheet = False
    Else
        Worksheets(cb.Caption).Select Replace:=False
    End If
End If
Next cb
ActiveWindow.SelectedSheets.PrintOut copies:=1
ActiveSheet.Select
End If
' ActiveSheet.PrintPreview 'for debugging
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
 
Upvote 0
Thank you! This worked, you're the man . One last question. I added a tab and noticed that the newly added tab does not get included in the single print job. Instead, the other tabs that are checked print as one job and the new tab prints separately. Do you know what's causing that?

Teeroy said:
OK since having one print job is a requirement try the following. It will select the first sheet checked without "Replace:= False" then use that argument for future selections. This should exclude the ActiveSheet from the selection.

Code: 
Sub Print_Sheets_Dialog_v4()

Application.Dialogs(xlDialogPrinterSetup).Show
Dim i As Integer
Dim TopPos As Integer
Dim SheetCount As Integer
Dim PrintDlg As DialogSheet
Dim CurrentSheet As Worksheet
Dim cb As CheckBox
Dim bFirstSheet As Boolean

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
Dim Hor As Integer 'this will be for the horizontal position of the items
Hor = 70
Dim wd As Integer 'this will be for the overall width of the dialog box
wd = 240
TopPos = 35
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
If SheetCount = 30 Then
Hor = 223
wd = 380
TopPos = 35
End If
PrintDlg.CheckBoxes.Add Hor, TopPos, 145, 16.5
PrintDlg.CheckBoxes(SheetCount).Text = _
CurrentSheet.Name
TopPos = TopPos + 13
End If
Next i
' Set dialog height, width, and caption
With PrintDlg.DialogFrame
.Height = 415
'.Height = Application.Max _
'(68, PrintDlg.DialogFrame.Top + TopPos)
.Width = wd
.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
' For Printing all selected sheets in one print job
If PrintDlg.Show Then
bFirstSheet = True
For Each cb In PrintDlg.CheckBoxes
If cb.Value = xlOn Then
    If bFirstSheet Then
        Worksheets(cb.Caption).Select
        bFirstSheet = False
    Else
        Worksheets(cb.Caption).Select Replace:=False
    End If
End If
Next cb
ActiveWindow.SelectedSheets.PrintOut copies:=1
ActiveSheet.Select
End If
' ActiveSheet.PrintPreview 'for debugging
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
Click to expand...
 
Upvote 0
Sorry I can't think what is causing that. The printout method is not inside any loop so should only run once, unless you have other event driven code that causes to macro to run more than once.
 
Upvote 0
You must log in or register to reply here.

Similar threads

T
  • Question Question
VBA Stuck Sanitising Several Sheets
Replies
2
Views
187
Tarkemelion
T
E
  • Question Question
VBA for printing multiple tabs excel for mac
Replies
5
Views
279
EBahn
E
E
  • Solved
Force Excel 2019 VBA to import multiple txt file to existing sheet & not seperate wk.book / wk.sheets
Replies
1
Views
570
Domenic
D
M
  • Question Question
Using VBA code in a protected excel sheet
Replies
2
Views
468
MagicCarpet
M
A
  • Question Question
Ask VBA how to Print separate PDF
Replies
6
Views
828
ceranes
C

Forum statistics

Threads
1,223,227
Messages
6,170,848
Members
452,361
Latest member
d3ad3y3

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