Exporting multiple ranges in alternating orientations to multiple page pdf

natphil

New Member
Joined
Aug 27, 2015
Messages
3
Hi Everyone,

My apologies in advance if this has already been answered; my searching has proven fruitless!

I am attempting to export different ranges of the same sheet as separate pages of a single pdf document. What I am after is:

Page 1 of the pdf:

With ActiveSheet.PageSetup
.Orientation = xlPortrait
.PrintArea = "B1:H54"
End With

Page 2 of the pdf.

With ActiveSheet.PageSetup
.Orientation = xlLandscape
.PrintArea = "J1:W54"
End With

Page 3 of the pdf.

With ActiveSheet.PageSetup
.Orientation = xlPortrait
.PrintArea = "Y1:AG54"
End With



Then something like this after where it exports the document to the spreadsheet file path and file name.

ActiveSheet.ExportAsFixedFormat Type:=x1TypePDF, _
Filename:=ActiveWorkbook.Path & "" & strFileName & ActiveSheet.Name, _
Quality:=xlQualityStandard, _
OpenAfterPublish:=True

So in summary, page 1 of the pdf should be exported as a portrait page between range "B1:H54", page 2 of the pdf should be landscape between range "J1:W54" and page 3 of the same pdf should be portrait between the ranges "Y1:AG54".

I would be very appreciative if someone could please help out with this. I'm way out of my depth on this one!
 

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.

John_w

MrExcel MVP
Joined
Oct 15, 2007
Messages
6,764
The page orientation is a property of the worksheet, so to get mixed portrait and landscape orientations we need to copy each range to a separate sheet and set the Orientation as appropriate. This macro copies the ranges to a temporary workbook with 3 sheets and exports it as a PDF.

Code:
Public Sub Export_Ranges_As_Portrait_and_Landscape_PDF()

    Dim sourceSheet As Worksheet
    Dim currentSheetsInNewWorkbook As Long
    Dim PDFfullName As String
    Dim PDFwb As Workbook
    
    With ActiveWorkbook
        Set sourceSheet = .ActiveSheet
        PDFfullName = .Path & "\PDF Output " & sourceSheet.Name & ".pdf"
    End With
    
    With Application
        currentSheetsInNewWorkbook = .SheetsInNewWorkbook
        .SheetsInNewWorkbook = 3        '3 sheets, because we want 3 sections in the PDF
        Set PDFwb = .Workbooks.Add
        .SheetsInNewWorkbook = currentSheetsInNewWorkbook
        .ScreenUpdating = False
    End With
       
    sourceSheet.Range("B1:H54").Copy PDFwb.Worksheets(1).Range("A1")
    PDFwb.Worksheets(1).PageSetup.Orientation = xlPortrait
    
    sourceSheet.Range("J1:W54").Copy PDFwb.Worksheets(2).Range("A1")
    PDFwb.Worksheets(2).PageSetup.Orientation = xlLandscape
    
    sourceSheet.Range("Y1:AG54").Copy PDFwb.Worksheets(3).Range("A1")
    PDFwb.Worksheets(3).PageSetup.Orientation = xlPortrait
    
    PDFwb.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFfullName, _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
    PDFwb.Close False
    
    Application.ScreenUpdating = True
    
    MsgBox "Created PDF file:" & vbCrLf & vbCrLf & PDFfullName
    
End Sub
 
Last edited:

natphil

New Member
Joined
Aug 27, 2015
Messages
3
Hi John,

Thank you very much for your efforts.

I have implemented this code but have run into another issue. This macro is successful in exporting the pages into the correct orientations; however it does not preserve any formatting in the process. Is their a way I could either a) preserve the formatting using your method or b) somehow export these three separate pages as separate .pdfs directly from the original workbook and combine after the fact (preferably automatically, but if this has to be completed manually then so be it).

Thank you in advance for your help.

Here is what the original formatting is supposed to be ->
1r1Jsy7
https://ibb.co/1r1Jsy7
1r1Jsy7

Here is what the macro spits the formatting out as ->
Ws64z1y
https://ibb.co/Ws64z1y
Ws64z1y
 

Watch MrExcel Video

Forum statistics

Threads
1,130,142
Messages
5,640,357
Members
417,139
Latest member
bdmprasenjit

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top