Marco for all selected sheets into one PDF file (my code needs small tweak)

[Excel_Vegas]

Hey guys - hoping that someone can help me here. I'm generally pretty handy in Excel but when it comes to <acronym>VBA</acronym>, 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.Activate

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

End Sub

 

[Excel_Vegas]

Anybody?

 

[Excel_Vegas]

lol...somebody?

Would really appreciate a hand with this!!