Print Multiple Sections in One Batch

[MrsAlice]

Dear All,

I am using this great Macro, for printing financials reports, developed by Chandoo.org. There's just one problem with the code: It prints all sections on a separate sheet, rather than in a single batch. Not necessarily a problem when physically printing a report, but it does become a problem when creating a report in *.pdf (using the print function). Is there any way how to adjust this code from printing everything on a single file (one section per *.pdf) to printing every section to one batch (all sections in one *.pdf)?

Your help is much appreciated!

Public Sub Print_Reports()
'
' Print_Reports
' Written Nov 2002
' by Hui:
'
' Published at Chandoo.org
' August 2011
'
               
Dim PrintArea As Variant
Dim i As Integer
Dim j As Integer
Dim sht As Long
Dim Orientation As String
Dim NCopies As Integer
Dim PWide As Integer
Dim PTall As Integer
Dim Footer As String
Dim Sheets As String
Dim gRow As Integer
Dim gCol As Integer
Dim PaperSize As String
Dim msg As String
Dim tmp As String


Application.Calculation = xlCalculationManual


PrintArea = Worksheets("Print_Control").Range("Print_Control").Value 'Loads the Print_Control Named Range
               
For j = 1 To [Copies].Value         'Loop through the No of Copies
  For i = 1 To UBound(PrintArea, 1)   'Loop through the print area
    If UCase(PrintArea(i, 3)) = "ON" Then    'When On is enabled Print using the settings


      Orientation = PrintArea(i, 6) 'Set Orientation variable
      PWide = PrintArea(i, 8)       'Set Pages Wide variable
      PTall = PrintArea(i, 9)       'Set Pages Tall variable
      NCopies = PrintArea(i, 10)    'Set No Copies variable
      gRow = PrintArea(i, 11)       'Set Row Group Expansion
      gCol = PrintArea(i, 12)       'Set Column Group Expansion
      Footer = PrintArea(i, 13)     'Set Footer variable
              
      'Set Paper size
      If PrintArea(i, 7) = "A4" Then
        PaperSize = 9
      ElseIf PrintArea(i, 7) = "A3" Then
        PaperSize = 8
      ElseIf PrintArea(i, 7) = "A5" Then
        PaperSize = 11
      ElseIf PrintArea(i, 7) = "Legal" Then
        PaperSize = 5
      ElseIf PrintArea(i, 7) = "Letter" Then
        PaperSize = 1
      ElseIf PrintArea(i, 7) = "Quarto" Then
        PaperSize = 15
      ElseIf PrintArea(i, 7) = "Executive" Then
        PaperSize = 7
      ElseIf PrintArea(i, 7) = "B4" Then
        PaperSize = 12
      ElseIf PrintArea(i, 7) = "B5" Then
        PaperSize = 13
      ElseIf PrintArea(i, 7) = "10x14" Then
        PaperSize = 16
      ElseIf PrintArea(i, 7) = "11x17" Then
        PaperSize = 17
      ElseIf PrintArea(i, 7) = "Csheet" Then
        PaperSize = 24
      ElseIf PrintArea(i, 7) = "Dsheet" Then
        PaperSize = 25
      Else
        PaperSize = 9 'Defaults to A4
      End If
      
      'Activate the relevent Sheet
      tmp = PrintArea(i, 4)
      If Not SheetExists(tmp) Then
        msg = "Sheet '" + PrintArea(i, 4) + "' not found." + vbCrLf + "Check the sheets Name."
        msg = msg + vbCrLf + vbCrLf + "Processing will continue for remaining sheets."
        tmp = MsgBox(msg, vbExclamation, "Sheet not Found")
      
      Else
        'The sheet exists now process
        Application.Sheets(PrintArea(i, 4)).Select
        
        If ActiveSheet.Type = -4167 Then 'Its a worksheet
          
          Application.ScreenUpdating = False
          
          ActiveSheet.PageSetup.PrintArea = PrintArea(i, 5) 'Select the relevent Print Area on the Sheet
          ActiveSheet.Outline.ShowLevels RowLevels:=gRow, ColumnLevels:=gCol   'Set Outline Grouping
          
          With ActiveSheet.PageSetup    'Set print settings
            .PrintTitleRows = ""
            .PrintTitleColumns = ""
            .LeftFooter = ""      'User Defined Footer (Shift to Left or Right as required)
            .CenterFooter = ""
            .RightFooter = Footer
            .LeftMargin = Application.InchesToPoints(0.8)
            .RightMargin = Application.InchesToPoints(0.5)
            .TopMargin = Application.InchesToPoints(1.5)
            .BottomMargin = Application.InchesToPoints(0.4)
            .HeaderMargin = Application.InchesToPoints(0.6)
            .FooterMargin = Application.InchesToPoints(0.3)
            .PrintHeadings = False
            .PrintGridlines = False
            .PrintComments = xlPrintNoComments
            .CenterHorizontally = False
            .CenterVertically = False
            .Draft = False
            .PaperSize = PaperSize      ' User Defined Paper Size
            .FirstPageNumber = xlAutomatic
            .Order = xlDownThenOver
            .BlackAndWhite = False
            .Zoom = False
            .FitToPagesWide = PWide     'User Defined No Pages Wide
            .FitToPagesTall = PTall     'User Defined No Pages Tall
            .PrintErrors = xlPrintErrorsDisplayed
          End With
          
          If Orientation = "L" Then     'User Defined Page Orientation
            ActiveSheet.PageSetup.Orientation = xlLandscape
          Else
            ActiveSheet.PageSetup.Orientation = xlPortrait
          End If
          
          Application.ScreenUpdating = True
          'Finished setting up Worksheet goto Printing
        
        Else  'Its a Chart page
          
          Application.ScreenUpdating = False
          
          With ActiveChart.PageSetup
            .LeftFooter = ""
            .CenterFooter = ""
            .RightFooter = Footer
            .LeftMargin = Application.InchesToPoints(0.2)
            .RightMargin = Application.InchesToPoints(0.2)
            .TopMargin = Application.InchesToPoints(1.9)
            .BottomMargin = Application.InchesToPoints(0.4)
            .HeaderMargin = Application.InchesToPoints(0.6)
            .FooterMargin = Application.InchesToPoints(0.3)
            .ChartSize = xlScreenSize
            .PrintQuality = 600
            .CenterHorizontally = True
            .CenterVertically = True
            .Draft = False
            .OddAndEvenPagesHeaderFooter = False
            .DifferentFirstPageHeaderFooter = False
            .EvenPage.LeftHeader.Text = ""
            .EvenPage.CenterHeader.Text = ""
            .EvenPage.RightHeader.Text = ""
            .EvenPage.LeftFooter.Text = ""
            .EvenPage.CenterFooter.Text = ""
            .EvenPage.RightFooter.Text = ""
            .FirstPage.LeftHeader.Text = ""
            .FirstPage.CenterHeader.Text = ""
            .FirstPage.RightHeader.Text = ""
            .FirstPage.LeftFooter.Text = ""
            .FirstPage.CenterFooter.Text = ""
            .FirstPage.RightFooter.Text = ""
            .PaperSize = PaperSize
            .FirstPageNumber = xlAutomatic
            .BlackAndWhite = False
            .Zoom = 80
          End With
          Application.ScreenUpdating = True
        
        End If
        
        ActiveWindow.SelectedSheets.PrintOut Copies:=NCopies, Collate:=True
      
      End If
    End If
  Next i
Next j


PrintArea = Null
Application.Calculation = xlCalculationAutomatic
Application.Sheets("Print_Control").Select


End Sub




Sub Setup_Print_Control_Named_Formula()
'
' Setup Print Control Named Range
'
ActiveWorkbook.Names.Add Name:="Print_Control", RefersToR1C1:= _
    "=OFFSET(Print_Control!R4C2,1,,COUNTA(Print_Control!R5C2:R24C2),COUNTA(Print_Control!R4))"
ActiveWorkbook.Names("Print_Control").Comment = _
    "Used by the Print_Reports Subroutine"


ActiveWorkbook.Names.Add Name:="Copies", RefersToR1C1:= _
    "=Print_Control!R26C13"
ActiveWorkbook.Names("Copies").Comment = _
    "Specifies the No. of Copies for the Print_Reports Subroutine"
End Sub