I am trying to save my worksheet as a pdf file with the use of vba. The worksheet is wider than an A4 page and contains a few shapes (side to side). I want the worksheet to fit on one A4 page, so it should be rescaled as seen on screen. I am using the following code:
Sub Print_PDF()
Dim sFilename As String
Worksheets.Add.Name = "Helpsheet"
sFilename = "G:\anything\test.pdf"
ThisWorkbook.Worksheets("Newsletter").Range("A2:D81").CopyPicture xlScreen, xlBitmap
ThisWorkbook.Sheets("Helpsheet").Activate
ThisWorkbook.Sheets("Helpsheet").Paste
ActiveSheet.PageSetup.PrintArea = ThisWorkbook.Sheets("Helpsheet").Range("A1:O86")
With ActiveSheet.PageSetup
.Orientation = xlPortrait
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
ThisWorkbook.Sheets("Helpsheet").ExportAsFixedFormat Type:=xlTypePDF, Filename:=sFilename, quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
Application.DisplayAlerts = False
ThisWorkbook.Sheets("Helpsheet").Delete
Application.DisplayAlerts = True
End Sub
The code actually saves a PDF file in the expected location. However, the PDF file is 4 pages instead of the expected 1 page. So it seems that the printarea is not defined correctly. What am I doing wrong?
Have you tried adjusting your PageSetup parameters as per this example?
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.Orientation = xlLandscape
.Zoom = False
'.PrintArea = Worksheets(ReportWsName).UsedRange
.FitToPagesWide = 1
'.FitToPagesTall = 1
End With
Application.PrintCommunication = True
Think explicitly setting .Zoom to false is important.
Source:
excel vba not exporting pagesetup to pdf correctly
Assuming the activesheet is also the sheet("Helpsheet")
The print area need the address of the print range.
ActiveSheet.PageSetup.PrintArea = ThisWorkbook.Sheets("Helpsheet").Range("A1:O86").Address
Related
I have an excel workbook with many sheets. The data needs to be converted to PDF.
Now the catch is that there are a few images that have to be present in the header and footer of the PDF. Also the page number needs to be printed.
Can u suggest the best approach to handle this. I work on VBA. Can anyone tell if this can be achieved using Excel - VBA?
Thanks a lot.
Try this approach, I have solved my problem with this.. as you haven't posted any specific details... you need to figure out how to use this code...
Private Sub CommandButton1_Click()
Dim wksAllSheets As Variant ' define a worksheet object arrray
Dim wksSheet1 As Worksheet ' a dummy variable
Dim strFilename As String ' file name
Dim strFilepath As String ' file path, default is the current working dir
' file destination folder name...
strFilepath = "C:\Reports"
' check if folder exist or not, if doesn't then creates it otherwise ignore it
If Len(Dir(strFilepath, vbDirectory)) = 0 Then
MkDir strFilepath
End If
strFilepath = strFilepath & "\"
' Initialize variables
wksAllSheets = Array("Strategy", "Summary", "Trades", "TradeAnalysis") '' array of sheetName i want to save as pdf
strFilename = "outputFileName.pdf"
'''''''''''''''''''''''''''''''''''' Here I am setting the page layout for each sheet, use if you need '''''''''''''''''''''''''''''''''''''''''''''''''
Set wksSheet1 = ThisWorkbook.Sheets("Strategy")
' change the page setup Attributes of 'Strategy' sheet object
With wksSheet1.PageSetup
.Orientation = xlLandscape
.PaperSize = xlPaperFanfoldLegalGerman
.Zoom = 85
.TopMargin = 0
.BottomMargin = 0
.RightMargin = 0
.LeftMargin = 0
.HeaderMargin = 0
.FooterMargin = 0
End With
' change the page setup Attributes of 'Summary' sheet object
Set wksSheet1 = ThisWorkbook.Sheets("Summary")
With wksSheet1.PageSetup
.Orientation = xlLandscape
.PaperSize = xlPaperLegal
.Zoom = 90
.TopMargin = 0.25
.BottomMargin = 0.25
.RightMargin = 0.25
.LeftMargin = 0.25
.HeaderMargin = 0.25
.FooterMargin = 0.25
End With
' change the page setup Attributes of 'Trades' sheet object
Set wksSheet1 = ThisWorkbook.Sheets("Trades")
With wksSheet1.PageSetup
.CenterHeader = "Trades"
.Orientation = xlLandscape
.PrintArea = "$B$2:$U$321" ' pass it as a parameter
.Zoom = 100
.PaperSize = xlPaperLegal
.PrintTitleRows = wksSheet1.Rows(2).Address
End With
' change the page setup Attributes of 'TradeAnalysis' sheet object
Set wksSheet1 = ThisWorkbook.Sheets("TradeAnalysis")
With wksSheet1.PageSetup
.CenterHeader = "TradeAnalysis"
.Orientation = xlPortrait
.LeftMargin = 0.25
.RightMargin = 0.25
.Zoom = 100
End With
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Save all the sheet in the array as one single PDF file
ThisWorkbook.Sheets(wksAllSheets).Select
wksSheet1.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=strFilepath & strFilename, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
'update the wksSheet1 object in with the next entry from wksAllSheets array of object
wksSheet1.Select
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
and here is a reference
With wb
Set Sh2 = .Sheets("sheet2)
With Sh2.PageSetup
.PrintArea = "$B$2:$S$80"
.PaperSize = xlPaperLegal
End With
Set Sh3 = .Sheets("sheet3")
With Sh3.PageSetup
.PrintArea = "$B$2:$M$104"
.PaperSize = xlPaperLegal
.Orientation = xlPortrait
End With
Set execsum1 = .Sheets("sheet4")
With execsum1.PageSetup
.PrintArea = "$B$7:$N$63"
.PaperSize = xlPaperLegal
.Orientation = xlLandscape
.PrintTitleRows = "$B$2:$N$6"
End With
Set execsum2 = .Sheets("sheet5")
With execsum2.PageSetup
.PrintArea = "$B$64:$N$106"
.PaperSize = xlPaperLegal
.Orientation = xlLandscape
.PrintTitleRows = "$B$2:$N$6"
End With
'ActiveSheet.PrintPreview
Set noi1 = .Sheets("sheet6")
With noi1.PageSetup
.PrintArea = "$B$10:$N$44"
.PaperSize = xlPaperLegal
.Orientation = xlLandscape
.PrintTitleRows = "$B$2:$N$8"
.FitToPagesTall = 1
End With
Set noi2 = .Sheets("sheet7")
With noi2.PageSetup
.PrintArea = "$B$46:$N$192"
.PaperSize = xlPaperLegal
.Orientation = xlLandscape
.PrintTitleRows = "$B$2:$N$8"
'.FitToPagesWide = 1
.FitToPagesTall = 1
End With
End With
Dim sheet As Variant
For Each sheet In Array(execsum1, execsum2, Sh2, Sh3, noi1, noi2)
sheet.PrintOut Copies:=1
Next
'Save and Close Workbook
'wb.Close SaveChanges:=False
'Ensure Workbook has closed before moving on to next line of code
DoEvents
'Get next file name
myFile = Dir
Loop
'Message Box when tasks are completed
MsgBox "Task Complete!"
ResetSettings:
'Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Hello all, I'm new to VBA and I'm trying to print 6 worksheets/pages per workbooks found in a folder. Execsum1 and execsum2 are from the same worksheet with different print areas; same story with noi1 and noi2. When I run the code, it prints out the second designated page twice (execsum2 and noi2). Why isn't execsum1/noi1 printing out and if possible, how can I make the code more efficient? Thanks.
It prints the same sheet twice because you aren't printing the worksheet between changing the PageSetup from your first version to your second version. You collect worksheet references here...
Set execsum1 = .Sheets("Exec Summary")
'...
Set execsum2 = .Sheets("Exec Summary")
...that are identical to each other. A worksheet only has 1 PageSetup, so when you do this...
For Each sheet In Array(execsum1, execsum2, Sh2, Sh3, noi1, noi2)
sheet.PrintOut Copies:=1
Next
...you get the last thing it was set to.
Just skip the loop entirely and print each individually. There is absolutely no benefit to looping over them.
With execsum1.PageSetup
.PrintArea = "$B$7:$N$63"
.PaperSize = xlPaperLegal
.Orientation = xlLandscape
.PrintTitleRows = "$B$2:$N$6"
End With
execsum1.PrintOut Copies:=1 '<--- After each With block.
If you want to simplify the code, just extract out the common .PageSetup into a function, and pass everything else as a parameter (note that this is just an example - I didn't include everything you're using). I.e.:
Private Sub PrintCustomRange(sheet As Worksheet, area As String, title As String, _
orient As XlPageOrientation, paper As XlPaperSize)
With sheet.PageSetup
.PrintArea = area
.PaperSize = paper
.Orientation = orient
If Len(title) > 0 Then .PrintTitleRows = title
End With
.PrintOut Copies:=1
End Sub
Then call it like this:
PrintCustomRange Sheets("Proforma NOI"), "$B$46:$N$192", "$B$2:$N$8", xlLandscape, xlPaperLegal
Am trying to convert microsoft excel file with large number of columns (70+) into pdf using a Excel VBA code.
In active workbook, am trying to save 'Sheet1' to PDF format at required path. I have the following code.
Sub GetSaveAsFilename()
Dim fileName As String
fileName = Application.GetSaveAsFilename(InitialFileName:="", _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Path and FileName to save")
If fileName <> "False" Then
With ActiveWorkbook
.Worksheets("Sheet1").ExportAsFixedFormat Type:=xlTypePDF, fileName:= _
fileName, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With
End If
End Sub
When am running the VBA code and saving the pdf file, I see that; the whole excelsheet is not fitted in same page. It's displaying some content in next page.
(Only few columns appear in first page, remaining appear on next page and so on..).
I checked with How to publish a wide worksheet in PDF format?.
But, setting page layout to landscape and converting excel file manually to PDF; also displays some columns in next pages.
There are many Free Excel to PDF Converters available online, which give me same results.
Is there any function available in VBA, through which I can fit all the columns in a single page of PDF?
The problem is with the Page Setup settings, I have done some minor changes to your code and added a procedure to perform the page setup settings, when launching the procedure you can select the paper size, however be aware the minimum zoom allowed is 10% (see PageSetup Members (Excel)). Therefore, if even at 10% the Print Area does not fit in one page I suggest to chose a larger paper size (i.e. A3) to generate an one page PDF, then when printing the Pdf select fit to page. The procedure also gives you the change to play with the margins, when generating PDF's I set all margins at 0, but you can changed as it fits your goals.
Sub Wsh_LargePrintArea_To_Pdf()
Dim WshTrg As Worksheet
Dim sFileName As String
sFileName = Application.GetSaveAsFilename( _
InitialFileName:="", _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Path and FileName to save")
If sFileName <> "False" Then
Rem Set Worksheet Target
Set WshTrg = ActiveWorkbook.Worksheets("Sheet1")
Rem Procedure Update Worksheet Target Page Setup
'To Adjust the Page Setup Zoom select the Paper Size as per your requirements
'Call Wsh_Print_Setting_OnePage(WshTrg, xlPaperLetter)
'Call Wsh_Print_Setting_OnePage(WshTrg, xlPaperA4)
'To Adjust the Page Setup Zoom select the Paper Size as per your requirements
'If the Print Still don't fit in one page then use a the largest Paper Size (xlPaperA3)
'When printing the Pdf you can still selet to fix to the physical paper size of the printer.
'Call Wsh_Print_Setting_OnePage(WshTrg, xlPaperA3)
'This is the largest paper i can see in my laptop is 86.36 cm x 111.76 cm
Call Wsh_Print_Setting_OnePage(WshTrg, xlPaperEsheet)
Rem Export Wsh to Pdf
WshTrg.ExportAsFixedFormat _
Type:=xlTypePDF, _
fileName:=sFileName, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End If
End Sub
Sub Wsh_Print_Setting_OnePage(WshTrg As Worksheet, ePaperSize As XlPaperSize)
On Error Resume Next
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftMargin = Application.InchesToPoints(0)
.RightMargin = Application.InchesToPoints(0)
.TopMargin = Application.InchesToPoints(0)
.BottomMargin = Application.InchesToPoints(0)
.HeaderMargin = Application.InchesToPoints(0)
.FooterMargin = Application.InchesToPoints(0)
'.Orientation = xlLandscape
.Orientation = xlPortrait
.PaperSize = ePaperSize
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
Application.PrintCommunication = True
End Sub
First select the range you want to print and set it as PrintArea. And then run this code, this work for me with an 79 columns sheet
Sub saveAsPDF()
Dim MyPath
Dim MyFolder
With Sheet1.PageSetup
'.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlLandscape
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
.BottomMargin = 0
.TopMargin = 0
.RightMargin = 0
.LeftMargin = 0
End With
MyPath = ThisWorkbook.Path
MyFolder = Application.GetSaveAsFilename(MyPath, "PDF Files (*.pdf),*.pdf")
If MyFolder = False Then Exit Sub
Sheet1.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=MyFolder, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End Sub
add this to your code, it will force everything to print on one sheet wide, but still let it print over multiple sheets tall
With Worksheets("Sheet1").PageSetup
.FitToPagesWide = 1
.FitToPagesTall = False
End With
also set your margins to "Narrow"
The problem is that you need to Select the UsedRange and then use Selection.ExportAsFixedFormat
Sub GetSaveAsFilename()
Dim fileName As String
fileName = Application.GetSaveAsFilename(InitialFileName:="", _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Path and FileName to save")
If fileName <> "False" Then
'Selecting the Used Range in the Sheet
ActiveWorkbook.Worksheets("Sheet1").UsedRange.Select
'Saving the Selection - Here is where the problem was
Selection.ExportAsFixedFormat Type:=xlTypePDF, fileName:=fileName, _
Quality:=xlQualityStandard, IncludeDocProperties:=False, _
IgnorePrintAreas:=False, OpenAfterPublish:=True
End If
End Sub
EDIT:
The problem was the PageSetupbecasue each page size has a maximum pixel limit as you were heading towards in your comment.
The Page Size is set to Oversize A0 which should more than cater for your 100x1500 UsedRange. Here you change the page size with the FitToPages... = 1 to check that your Range is within the print lines.
The FitToPagesWide and FitToPagesTall is to fit everything onto one page.
Sub GetSaveAsFilename()
Dim fileName As String
fileName = Application.GetSaveAsFilename(InitialFileName:="", _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Path and FileName to save")
If fileName <> "False" Then
'Suspending Communicaiton with Printer to Edit PageSetup via Scripting
Application.PrintCommunication = False
'Setting Page Setup
With ActiveSheet.PageSetup
.FitToPagesWide = 1
.FitToPagesTall = 1
' Setting Page Size to 92x92 inch Should cater for your data
.PaperSize = 159
End With
'Enabling Communicaiton with Printer
Application.PrintCommunication = True
'Selecting the Used Range in the Sheet
ActiveWorkbook.Worksheets("Sheet1").UsedRange.Select
'Saving the Selection - Here is where the problem was
Selection.ExportAsFixedFormat Type:=xlTypePDF, fileName:=fileName, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=True, OpenAfterPublish:=True
End If
End Sub
Note that the Page will appear Blank, you will need to Zoom in alot to view the data
I have code which formats a worksheet to the desired setup and layout (one page wide and tall in landscape). When I run the code (part of a long macro) it formats the pagesetup correctly.
If I manually export and save it as a pdf, then it uses the correct page setup, producing a one page PDF that is in landscape. However, the same export done by VBA produces a PDF that is severalpages long and in portrait.
i can't figure out why it's doing this. i've tried various solutions such as selecting the worksheet before exporting it, but all to no avail.
Any help is appreciated.
Code looks like this:
Sub SaveAsPDF()
Sheets(ReportWsName).ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
[SaveFolderPath] & "\" & ReportWsName, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
End Sub
UPDATE:
Code used to format the pagesetup (since it's rather long I am only adding the relevant section of that sub)
Private Sub CreateNewReport(ProvisionCode As String, TimeFrom As Date, TimeTo As Date)
... other code here...
'Format report to create the desired layout
With Worksheets(ReportWsName)
'Delete unnecessary data and format the rest
.Range("A:B,D:D,F:G,J:M,O:O,Q:S").Delete Shift:=xlToLeft
.Range("A:F").EntireColumn.AutoFit
.Range("C:C, E:F").ColumnWidth = 30
With .Range("G:G")
.ColumnWidth = 100
.WrapText = True
End With
'Insert standard formating header form Reporting template
.Rows("1:2").Insert
wsReportTemplate.Range("1:3").Copy .Range("A1")
.Range("A2") = "Notes Report for " & ProvisionCode & " (" & TimeFrom & " - " & TimeTo & ")"
'Insert standard formating footer form Reporting template
wsReportTemplate.Range("A6:G7").Copy .Range("A" & .UsedRange.Rows.Count + 2)
'Ensure all data is hard coded
.UsedRange.Value = .UsedRange.Value
'Format Print Area to one Page
With ActiveSheet.PageSetup
.PrintArea = Worksheets(ReportWsName).UsedRange
.Orientation = xlLandscape
.FitToPagesWide = 1
End With
End With
End Sub
I have found what seems to be the solution:
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.Orientation = xlLandscape
.Zoom = False
'.PrintArea = Worksheets(ReportWsName).UsedRange
.FitToPagesWide = 1
'.FitToPagesTall = 1
End With
Application.PrintCommunication = True
I needed to add the Application.PrintCommunication part to the equation. For whatever reason Excel would overwrite the settings I was putting if I ran the code without it.
I think the problem is that you need to add the .Zoom = False to your page setup code:
'Format Print Area to one Page
With ActiveSheet.PageSetup
.PrintArea = Worksheets(ReportWsName).UsedRange
.Orientation = xlLandscape
.FitToPagesWide = 1
.Zoom = False 'I have added this line
End With
From what I have tried this should solve it for you.
Let me know how it goes!
EDIT: Maybe you need:
'Format Print Area to one Page
With ActiveSheet.PageSetup
.PrintArea = Worksheets(ReportWsName).UsedRange
.Orientation = xlLandscape
.FitToPagesWide = 1
.FitToPagesTall = 1
.Zoom = False 'I have added this line
End With
EDIT2: What if you changed:
.PrintArea = Worksheets(ReportWsName).UsedRange
To
.PrintArea = Worksheets(ReportWsName).UsedRange.Address
Yes!!!, I have had the same problem: I was not able to export a sheet with the page Setup settings already applied on it.
Before trying the Application.PrintCommunication I tested Wait and Sleep commands without success. Finally I skipped this issue by using CopyPicture method, adding a chart page and then exporting it to pdf, but resolution in my pdf it was not fine and I was not able to play with margins.
So just add Application.PrintCommunication=false before your code , on pagesetup settings like CaptainABC says and most important: close with Application.PrintCommunication=true after the code.
Thank you for this useful post.
I wonder if anybody can help me. I have a macro which selects sheets that are named as employees and puts them into the correct workbook dependant on where they work.
I have made the macro so that it selects all sheets for the depot then copies them into a new workbook.
My problem is when it can't find one of the sheets it skips all of them for that location workbook. and moves to the next location. Is there a way round this so if the macro can't find one of the sheets it moves the rest of them anyway.
Sub BIR()
On Error GoTo Getout
Sheets(Array("Martyn Arthur Lewis", "Norman Stewart Gray")).Move
Sheets.Select
For Each ws In Worksheets
ws.Activate
With ActiveSheet.PageSetup
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 90
.printerrors = xlPrintErrorsBlank
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = False
End With
Next
ChDir "\\afi-uplift\documents\company\Support Services\Support Services Level 1\Reports\Transport Reports\Vehicle KPI"
ActiveWorkbook.SaveAs Filename:="\\afi-uplift\documents\company\Support Services\Support Services Level 2\Support Services\Transport\Drivers\Driver Performance\BIR Driver KPI " & Format(Date, "yyyy.mm.dd") & ".xlsx" _
, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Windows("Driver Report.xlsm").Activate
Getout:
End Sub
I don't understand why people always need to use .select and .activate
First it slows the program, and second, usualy, you don't even need to select/activate.
Doesn't your code work if you write it like this :
option explicit 'forces user to dim variables, , alot easier to find errors
err.clear
on error goto 0 'how can you debug errors with a on error goto (or on error resume next) ?
dim ws as worksheet
For Each ws In Sheets(Array("Martyn Arthur Lewis", "Norman Stewart Gray"))
With ws.PageSetup
'your code
end with
next ws