• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Print Multiple Section in One Batch

B

Berry

New Member
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!

Code: 
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
 
Before trying to tackle this, do you happen to have Adobe Standard rather than just Reader? If so, it's fairly simple to combine multiple pdf's into a single file. Looking into Hui's code I can understand what he's doing, but I'm not sure how to get it all into "one file" and still keep the baility of selecting different ranges. :(
 
Hi Luke,

Thank you for your quick reply. I understand what you are saying and I am indeed using (a program similar to) Adobe Standard in order to merge the separate *.pdf files. The 'problem' here is not so much the merging, as it is the fact that for every single section I need to print/save a separate *.pdf, which can take a while if your report consists of about 60 pages.

Looking forward to hear more about this!
 
In that case, I might be able to help out. :)
Tweaked the code so that if you indicate you want a PDF, it creates all the files w/o having to stop and ask for each sheet.
Code: 
Option Explicit
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 Header 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
Dim PrintPdf As VbMsgBoxResult
Dim FileName As String, FilePath As String
Application.Calculation = xlCalculationManual
PrintArea = Worksheets("Print_Control").Range("Print_Control").Value 'Loads the Print_Control Named Range
PrintPdf = MsgBox("Are you priting a pdf?", vbYesNo, "PDF?")
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
  Header = PrintArea(i, 2)  'Set Header variable
  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 = ""
  .LeftHeader = ""
  .CenterHeader = Header  'User Defined Header (Shift to Left or Right as required)
  .RightHeader = ""
  .LeftFooter = Footer  'User Defined Footer (Shift to Left or Right as required)
  .CenterFooter = ""
  .RightFooter = ""
  .LeftMargin = Application.InchesToPoints(0.1)
  .RightMargin = Application.InchesToPoints(0.1)
  .TopMargin = Application.InchesToPoints(1#)
  .BottomMargin = Application.InchesToPoints(0.4)
  .HeaderMargin = Application.InchesToPoints(0.1)
  .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
  .LeftHeader = ""
  .CenterHeader = Header
  .RightHeader = ""
  .LeftFooter = Footer
  .CenterFooter = ""
  .RightFooter = ""
  .LeftMargin = Application.InchesToPoints(0.1)
  .RightMargin = Application.InchesToPoints(0.1)
  .TopMargin = Application.InchesToPoints(1#)
  .BottomMargin = Application.InchesToPoints(0.4)
  .HeaderMargin = Application.InchesToPoints(0.1)
  .FooterMargin = Application.InchesToPoints(0.3)
  .ChartSize = xlScreenSize
  .PrintQuality = 600
  .CenterHorizontally = True
  .CenterVertically = True
  .Orientation = xlLandscape
  .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 = 100
  End With
  Application.ScreenUpdating = True
  
  End If
  'Check if user indicated we are doing pdfs
  If PrintPdf = vbYes Then
  'Set up what to name the file using a incrementing system
  FileName = "My Pdf" & i
  'Save in same location as workbook for now
  'Can be changed if desired
  FilePath = ThisWorkbook.Path & "\"
  ActiveWindow.ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:=FilePath & FileName, _
  Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  Else
  ActiveWindow.SelectedSheets.PrintOut Copies:=NCopies, Collate:=True
  End If
  
  End If
  End If
  Next i
Next j
PrintArea = Null
Application.Calculation = xlCalculationAutomatic
Application.Sheets("Print_Control").Select
End Sub
 
Great! I will try it first thing tmw.

Your code brings me to another (sort of related) question: Is there a VBA code for a button within excel that can help me switch the Windows defaukt printer, without actually having to select it in the control panel?
 
Hi Luke,

I tried your code, and essence it works great. Just a small problem: Somehow the sizes (width x height) of the separate *.pdf files differ from each other. Combining these files, then results in some pages being very large, while others turn out to be smaller. Any idea how to solve this?

Thanks again!
 
I would hazard a guess that it's some setting when you combine the documents. On my machine, when I combine files a wizard opens up, and I have the option to preserve sizes. Does somethign similar exist for you?
 
Not that I am aware of (I use Adobe Acrobat Pro XI).
Select files, right mouse click, 'Combine Files in Acrobat'.

No such a setting in VBA? I mean, when saving the file as *.pdf, add a parameter for papersize (A4)? In the original code (which actually printed the excel sections in *.pdf, rather than directly saving them in *.pdf), this problem did not appear.
 
Hmm. I'm afraid I don't know the solution. I'm guessing the VB problem is that the Export as pdf is called against ActiveSheet, while the PrintOut is called against SelectedSheets. But the SelectedSheets does not have an export method... I'm afraid I'm stumped. :(
 
Solution found:

In Excel, go to File > Options > Advanced.
Under General section, uncheck ‘Scale content for A4 or 8.5 x 11” paper size’ and click OK.
 
Hurrah! Glad you were able to find and answer, and thanks for letting the community know.
 
You must log in or register to reply here.
Back
Top