Print Multiple Prin Ranges to PDF as one document

jl2509 · Jan 29th 2018

Hi All,

Struggling with some VBA to print multiple print ranges to one document ( 3 pages)
Code below is my attempt so far but I am not sure how to print an array for multiple ranges !

Any thoughts please?
I know the code needs cleaning up somewhat and would also appreciate some help there too.

Code

Sub PrintPDFPrint()


Dim wsA As Worksheet
Dim wbA As Workbook
Dim strTime As String
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
On Error GoTo errHandler


Set wbA = ActiveWorkbook
Set wsA = ActiveSheet


strTime = Format(Now(), "dd mmm yyyy")
strPath = wbA.Path


With ActiveSheet.PageSetup
    .PrintTitleRows = ""
    .PrintTitleColumns = ""
    .LeftMargin = Application.CentimetersToPoints(1.5)
    .RightMargin = Application.CentimetersToPoints(1.5)
    .TopMargin = Application.CentimetersToPoints(1.9)
    .BottomMargin = Application.CentimetersToPoints(1.9)
    .HeaderMargin = Application.CentimetersToPoints(0.9)
    .FooterMargin = Application.CentimetersToPoints(0.9)
    .PaperSize = xlPaperA4
    .PrintQuality = 600
    .Orientation = xlPortrait
    .Zoom = False
    .Draft = False
    .FitToPagesWide = 1
    .FitToPagesTall = 3
End With


PrntArea = Array("$D$1:$M$40", "$D$42:$M$67", "$D$69:$M$90")
ActiveSheet.PageSetup.PrintArea = PrntArea(i)
Worksheets("HRReviews").PageSetup.CenterHorizontally = True


    
If strPath = "" Then
  strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"




strName = Replace(wsA.Name, " ", "")
strName = Replace(strName, ".", " - ")




strFile = " - " & strTime & ".pdf"
strPathFile = strPath & strFile


myFile = Application.GetSaveAsFilename _
    (InitialFileName:=Range("F6").Value & " - Progress " & Range("F4").Value & strFile, _
        FileFilter:="PDF Files (*.pdf), *.pdf", _
        Title:="Select Folder and FileName to save")




If myFile <> "False" Then
    wsA.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        filename:=myFile, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False


    MsgBox "PDF file has been created: " _
      & vbCrLf _
      & myFile
      
End If


exitHandler:
    Exit Sub
errHandler:
    MsgBox "Could not create PDF file"
    Resume exitHandler
End Sub

Display More

jolivanes · Jan 29th 2018

Code

PrntArea = Array("$D$1:$M$40", "$D$42:$M$67", "$D$69:$M$90")

Have you tried setting the print area to D1:M90, insert horizontal page breaks at the appropiate rows and hide the rows you don't want to print?
Reset back to regular after printing.

jolivanes · Jan 29th 2018

See if you can play with this to make it work.
The first two lines are because of a problem with page breaks in excel

Code

Sub AAAAA()
    ActiveWindow.View = xlPageBreakPreview
    ActiveWindow.View = xlNormalView
        ActiveSheet.ResetAllPageBreaks
            ActiveSheet.PageSetup.PrintArea = Range("D1:M90")
                Range("41:41, 68:68").EntireRow.Hidden = True
            With ActiveSheet.HPageBreaks
                .Add (Cells(41, 1))
                .Add (Cells(68, 1))
            End With
'<----- Print to PDF here
    Range("41:41, 68:68").EntireRow.Hidden = False
End Sub

Display More

jl2509 · Jan 30th 2018

Hi

I initially had the range set as you mentioned but could not get manual page breaks to set. I believe the issue there was related to "Fit pages to 1 sheet wide by 3 sheets tall. This messed things up every time and could not change the page breaks in VBA.

I'm not full conversant with VBA or formulas come to that, and don't really understand how to implement your proposal.

Any chance you could take a look at my code and implement something there that will run a print for the 3 ranges into one document??

Thanks

jolivanes · Jan 30th 2018

Have you tried to set the "Fit to pages tall" to 1?

jolivanes · Jan 30th 2018

Maybe try this

Code

Sub AAAAA()
    ActiveWindow.View = xlPageBreakPreview
    ActiveWindow.View = xlNormalView
        ActiveSheet.ResetAllPageBreaks
        
            ActiveSheet.PageSetup.PrintArea = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row).Resize(, 9).Address    '<----- Change as needed


            Range("41:41, 68:68").EntireRow.Hidden = True
            
            With ActiveSheet.HPageBreaks
                .Add (Cells(41, 1))
                .Add (Cells(68, 1))
            End With


        '<----- Change name to be saved as, and maybe the path, in following lines
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ActiveWorkbook.Path & "\" & "Temp_Temp_Temp", _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False


    Range("41:41, 68:68").EntireRow.Hidden = False
End Sub

Display More

jl2509 · Jan 31st 2018

Appreciate the help here.
I'll run with your proposal and see how I progress.

Thanks

Print Multiple Prin Ranges to PDF as one document

Participate now!

Share