Print code with checkbox and print dialogue/summary

MrGilb

New Member
Joined
Mar 19, 2014
Messages
2
Hi,

I'm in need of some help regarding printing in excel with a vba code.

At the moment I have a checkbox which pops up when you click the "Print" button I created on the sheet. But once you have selected the sheets you want and hit "OK" it goes straight through to the printer.


I'm hoping there is a way of having the pop up menu like above, but when you hit "OK" it takes you through to the printing options dialogue, where you can choose what printer, margin options, orientation, active sheets and so on, like the image below.. and ideally, with the print preview.



The current print code I'm using is this one, which i found online. If someone could lend me a few minutes to show me what extra bit of code to put where I would really appreciate it!

-----------------------------------------------------------------------------------

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

' 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 Each Wsh In ActiveWorkbook.Worksheets
' Skip empty sheets and hidden sheets
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

' 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
If SheetCount <> 0 Then
If PrintDlg.Show Then
'* Re-use SheetCount as flag [1= 1st sheet, 2=Other sheets]
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

' Delete temporary dialog sheet (without a warning)
Application.DisplayAlerts = False
PrintDlg.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True

' Reactivate original sheet
CurrentSheet.Activate


End Sub
 

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).

Forum statistics

Threads
1,214,922
Messages
6,122,281
Members
449,075
Latest member
staticfluids

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