vba Export Excel to PDF. 2 pages. One Portrait, One landscape.

Davavo

Board Regular
Joined
Aug 3, 2019
Messages
76
Hello, if anyone knows how to do this, I would appreciate a pointer. There are a few threads on it but i havent found one that actually answers the question of how to do it as one PDF with different orientations per page.

This is where i am at so far...

Code:
Sub ExportPDF2()    Dim sFile As String


    sFile = "C:\Users\David\Documents\Projects\Internal\PDFs" & "filenm" & ".pdf"


    Worksheets("Summary").PageSetup.Orientation = xlPortrait
    Worksheets("Detail").PageSetup.Orientation = xlLandscape
    
    Sheets(Array("Summary", "Detail")).Select
      
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
      Filename:=sFile2, Quality:=xlQualityStandard, _
      IncludeDocProperties:=True, IgnorePrintAreas:=False, _
      OpenAfterPublish:=True
End Sub
Many thanks in advance for any guru
 
Last edited:

Logit

Well-known Member
Joined
Aug 31, 2016
Messages
2,919
Give this a try :

Code:
Option Explicit


Sub Export_Worksheet_to_PDF()
Dim ws1 As String, ws2 As String
Dim filenm As String
Dim sFile As String


 ws1 = Sheet1.Name
 ws2 = Sheet2.Name


Sheet1.PageSetup.Orientation = xlPortrait
Sheet2.PageSetup.Orientation = xlLandscape


sFile = "C:\Users\David\Documents\Projects\Internal\PDFs" & filenm & ".pdf"


    Sheet1.Select
    
    filenm = CreateObject("Scripting.FileSystemObject").GetBaseName(ws1)
    sFile = "C:\Users\My\Desktop\" & filenm & ".pdf"
    ActiveSheet.ExportAsFixedFormat 0, sFile
    
    Sheet2.Select
    
    filenm = CreateObject("Scripting.FileSystemObject").GetBaseName(ws2)
    sFile = "C:\Users\My\Desktop\" & filenm & ".pdf"
    ActiveSheet.ExportAsFixedFormat 0, sFile
    
End Sub
 

Davavo

Board Regular
Joined
Aug 3, 2019
Messages
76
Give this a try :

Code:
Option Explicit


Sub Export_Worksheet_to_PDF()
Dim ws1 As String, ws2 As String
Dim filenm As String
Dim sFile As String


 ws1 = Sheet1.Name
 ws2 = Sheet2.Name


Sheet1.PageSetup.Orientation = xlPortrait
Sheet2.PageSetup.Orientation = xlLandscape


sFile = "C:\Users\David\Documents\Projects\Internal\PDFs" & filenm & ".pdf"


    Sheet1.Select
    
    filenm = CreateObject("Scripting.FileSystemObject").GetBaseName(ws1)
    sFile = "C:\Users\My\Desktop\" & filenm & ".pdf"
    ActiveSheet.ExportAsFixedFormat 0, sFile
    
    Sheet2.Select
    
    filenm = CreateObject("Scripting.FileSystemObject").GetBaseName(ws2)
    sFile = "C:\Users\My\Desktop\" & filenm & ".pdf"
    ActiveSheet.ExportAsFixedFormat 0, sFile
    
End Sub
Thanks very much for this, but i cant get it to work.
Also, wouldn't this produce 2 files if it did work?

The 'filenm' variable that i had inserted in the code was meant to be "text" as it was just a placeholder for adding a cell value.

I do actually want to reference a cell that holds the file ID which is generated from user input.

Getting the PDF output as a single file seems very tricky. :(

Code:
Sub Export_Worksheet_to_PDF()Dim ws1 As String, ws2 As String
Dim filenm As String
Dim sFile As String




 ws1 = Sheet1.Name
 ws2 = Sheet2.Name
 'filenm = Range("AC5")
 'i want to add the line above as the workbook is a template and when filled, the file name has to be generated dynamically depending on user entry values.
 
Sheet1.PageSetup.Orientation = xlPortrait
Sheet2.PageSetup.Orientation = xlLandscape




sFile = "C:\Users\David\Documents\Projects\Internal\PDFs" & filenm & ".pdf"




    Sheet1.Select
    
    filenm = CreateObject("Scripting.FileSystemObject").GetBaseName(ws1)
    sFile = "C:\Users\My\Desktop\" & filenm & ".pdf"
    ActiveSheet.ExportAsFixedFormat 0, sFile  'run time error 1004 here. "The document could not be saved. The documentr may be open or an error may have been encountered before saving."
    
    Sheet2.Select
    
    filenm = CreateObject("Scripting.FileSystemObject").GetBaseName(ws2)
    sFile = "C:\Users\My\Desktop\" & filenm & ".pdf"
    ActiveSheet.ExportAsFixedFormat 0, sFile
    
End Sub
 

John_w

MrExcel MVP
Joined
Oct 15, 2007
Messages
5,995
Your original code should work with 2 changes:
Code:
Sub ExportPDF2()    
    Dim sFile As String


    sFile = "C:\Users\David\Documents\Projects\Internal\PDFs\" & Worksheets("Summary").Range("A1").Value & ".pdf"


    Worksheets("Summary").PageSetup.Orientation = xlPortrait
    Worksheets("Detail").PageSetup.Orientation = xlLandscape
    
    Sheets(Array("Summary", "Detail")).Select
      
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
      Filename:=sFile, Quality:=xlQualityStandard, _
      IncludeDocProperties:=True, IgnorePrintAreas:=False, _
      OpenAfterPublish:=True
End Sub
The PDF file name (without the .pdf extension) is taken from cell A1 on the Summary sheet - change this as required.
 

Davavo

Board Regular
Joined
Aug 3, 2019
Messages
76
Your original code should work with 2 changes:
Code:
Sub ExportPDF2()    
    Dim sFile As String


    sFile = "C:\Users\David\Documents\Projects\Internal\PDFs\" & Worksheets("Summary").Range("A1").Value & ".pdf"


    Worksheets("Summary").PageSetup.Orientation = xlPortrait
    Worksheets("Detail").PageSetup.Orientation = xlLandscape
    
    Sheets(Array("Summary", "Detail")).Select
      
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
      Filename:=sFile, Quality:=xlQualityStandard, _
      IncludeDocProperties:=True, IgnorePrintAreas:=False, _
      OpenAfterPublish:=True
End Sub
The PDF file name (without the .pdf extension) is taken from cell A1 on the Summary sheet - change this as required.

No, sorry, it doesnt work.
The code works for each sheet individually, but when the array is used, it creates a PDF of only the first sheet in the array.
I switched them around and it is always the first. I added a sheet and it still exports on the first sheet in the array.
I am clueless here.
 

Davavo

Board Regular
Joined
Aug 3, 2019
Messages
76
This seems to solve it. The issue isnt with page orientations, but with printer selection.
Judging by the google hits, its not that uncommon an issue.
The following script allows export to 1 pdf of several excel sheets that are in both portrait and landscape orientation.
It is cobbled together from so many different sources that i couldnt possibly acknowledge all. None of it is mine. The method of finding out the printer list is from Rick Rothstein on this forum.
https://www.mrexcel.com/forum/excel-questions/889824-vba-get-combobox-all-printers-list.html

Thanks everyone who helped or tried to. Hope its useful for someone else.


Code:
Sub SaveAndArchive()


Dim wb As Workbook
Dim ws As Worksheet
Dim Path As String
Dim strPName As String
   
Set wb = ThisWorkbook
Set ws = wb.Sheets("Summary")


'set the path to the folder that the PDF is to be stored,  and the filename.  In this case the filename is todays date and a value from a cell in the workbook.
  
  Path = "C:\Users\David\Documents\Projects\Internal\ExpenseClaimForms\PDF_Archive" & "\" & Format(Now, "dd-mm-yyyy-") & wb.Sheets("Summary").Range("AC5") & ".pdf"
  
  Application.ScreenUpdating = False
  
With wb
    Sheets("Summary").Select
    Sheets("Summary").Unprotect Password:="****"
    ws.Range("K10") = Path                                      'write the filename to a cell, for visual reference from hard-copy.
    Sheets("Summary").Protect Password:="****"
  
    strPName = Application.ActivePrinter                        'this records the current printer so that the setting can be returned to previous after exporting the file to pdf
  
    Sheets(Array("Summary", "Detail")).Select
    
    'expression.PrintOut (From, To, Copies, Preview, ActivePrinter, PrintToFile, Collate, PrToFileName, IgnorePrintAreas)
    'printtofile true/false doesnt seem to have any effect.  Time will tell so be aware this setting may be incorrect.
    'The activeprinter should be set to whatever your system calls the pdf printer, i dont know if it is standard.  I will include Rick Rothsteins little script for finding out.
    
    ActiveWindow.SelectedSheets.PrintOut , , 1, , ActivePrinter:="Microsoft Print to PDF", Printtofile:=False, Collate:=True, PrToFileName:=Path, Ignoreprintareas:=False


    MsgBox "File Archived as PDF: " & Range("K10").Value        'message box that tells user where the pdf has been saved to.
  
    Application.ActivePrinter = strPName                        'returns the printer settings to whatever they were prior to running the script.
                                                                'handy if you dont want irate colleagues
 
End With
  
    wb.Close SaveChanges:=True                                  'this is important if you dont want multiple instances of excel running and issues with the VBA editor
    Set wb = Nothing                                            'i dont know why this happens but it seems to be a fairly common issue.  This method of closing seems to work.
  
    
  


End Sub
  
  
 Sub PrintersToFormsListBox() 'make a listbox and assign this code to it.  Run the code and you will get a list of the printers on your system.
  Dim X As Long, Printers As Object, arrPrinters As Variant
  With CreateObject("WScript.Network")
    For X = 1 To .EnumPrinterConnections.Count Step 2
      ActiveSheet.Shapes("List Box 1").ControlFormat.AddItem .EnumPrinterConnections(X)
    Next
  End With
End Sub
 
Last edited:

Forum statistics

Threads
1,081,577
Messages
5,359,731
Members
400,545
Latest member
Damntheman30

Some videos you may like

This Week's Hot Topics

  • VBA (Userform)
    Hi All, I just would like to know why my code isn't working. Here is my VBA code: [CODE=vba]Private Sub OKButton_Click() Dim i As Integer...
  • List box that changes fill color
    Hello, I have gone through so many pages trying to figure this out. I have a 2020 calendar that depending on the day needs to have a certain...
  • Remove duplicates and retain one. Cross-linked cases
    Hi all I ran out of google keywords to use and still couldn't find a reference how to achieve the results of a single count. It would be great if...
  • VBA Copy and Paste With Duplicates
    Hello All, I'm in need of some input. My VBA skills are sub-par at best. I've assembled this code from basic research and it works but is...
  • Macro
    is it possible for a macro to run if the active cell value is different to the value above it
  • IF DATE and TIME
    I currently use this to check if date has passed but i also need to set a time on it too. Is it possible? [CODE=vba]=IF(B:B>TODAY(),"Not...
Top