Print with checkbox for sheets and combine into single PDF (code available, needs mods?)

[Excel_Vegas]

Hey guys - hoping that someone can help me here. I'm generally pretty handy in Excel but when it comes to VBA, I'm basically a total hack. I usually search for strings of code and do the copy/paste/pray routine.

I'm looking for a string of code that will prompt the user to check-off boxes specifying the sheets they'd like to print, then have it save into a SINGLE pdf file. I'm using the below code right now and it will prompt check-boxes, and print using PDF but it does it one sheet/one PDF at a time. Any way to mod this so it will combine and save into a single PDF?



Sub SelectSheets() 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).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 CurrentSheet.ActivateApplication.ActivePrinter = "Adobe PDF on Ne03:"End Sub</pre>

 

[Excel_Vegas]

Let's try posting the current VBA coding again here....

Sub SelectSheets()
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).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
CurrentSheet.Activate

ActivateApplication.ActivePrinter = "Adobe PDF on Ne03:"End Sub

End Sub