Modify macro to allow selecting a printer

Mldeuser

Well-known Member
Joined
Dec 27, 2008
Messages
574
Office Version
  1. 365
Platform
  1. Windows
Good Morning

Can the macro below be modified to allow the user to select the printer instead of using the default printer.

Thank you

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 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).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
 

Excel Facts

Format cells as time
Select range and press Ctrl+Shift+2 to format cells as time. (Shift 2 is the @ sign).
Replace:
Code:
ActiveSheet.PrintOut
with:
Code:
Application.Dialogs(xlDialogPrint).Show
 
Upvote 0
That worked thank you.

Can this be done so that you only have to select the printer once, instead of for every worksheet selected.

Thank you
 
Upvote 0
This should work - it uses a boolean switch to test if the printer's been set to the desired one, and if not it brings up the print dialogbox.
If this has already been done for the first sheet, the printer's already correct, and the code skips this line:
Code:
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
Dim swch As Boolean
swch = False
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 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).Activate
'Test if the printer's been re-set - if not show the print dialog, select the correct printer, then print the sheet. If it has, just printout.
If swch = False Then Application.Dialogs(xlDialogPrint).Show: swch = True: GoTo skip1
ActiveSheet.PrintOut
' ActiveSheet.PrintPreview 'for debugging
skip1: 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
swch = false
End Sub
Probably best to just copy and paste the whole lot into your project - but don't forget to keep the original, just in case it doesn't have the desired results.
 
Last edited:
Upvote 0

Forum statistics

Threads
1,224,616
Messages
6,179,908
Members
452,949
Latest member
beartooth91

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