PDA

View Full Version : Save Excel to PDF one page wide



brent.fraser
07-10-2013, 12:04 PM
Hey all,

I am working on a "save Excel to PDF" and I want the PDF to be one page wide by how many pages long doesn't matter to me.

I have the save Excel to PDF part down but it is saving my document NOT one page width. I have set the print area on the Excel sheet.

Here's the code:
Option Explicit

Sub SheetsAsPDFsAllPromotions1PageWide()
Dim Sheet As Worksheet, SheetName$, MyFilePath$, N&
MyFilePath$ = "G:\Tech Writing Stuff\Templates\Project Services\" & _
Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4) & Format(Date, "MM-DD-YYYY")
With Application
.ScreenUpdating = False
.DisplayAlerts = False
On Error Resume Next '<< a folder exists
For N = 1 To Sheets.Count
Sheets(N).Activate
SheetName = ActiveSheet.Name
Cells.Copy
Workbooks.Add (xlWBATWorksheet)
With ActiveWorkbook
With .ActiveSheet
.Paste
.Name = SheetName
[A1].Select
.PageSetup.Orientation = xlLandscape
.PageSetup.FitToPagesWide = 1
End With
'save book in this folder
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=MyFilePath, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
.Close SaveChanges:=False
End With
.CutCopyMode = False
Next
End With
Sheet1.Activate
End Sub

Is there something I am missing? I even have .PageSetup.FitToPagesWide = 1

Thanks in advance peoples.

Brent

joms
07-11-2013, 02:31 AM
hi brent, you mean to print either in portrait or landscape?

well if you want to set either in portrait or landscape here's a code sinppet:


With ActiveSheet.PageSetup
.Orientation = xlLandscape
.PrintOut
End With

brent.fraser
07-11-2013, 06:42 AM
Hello Joms,

Thanks for the code.

What I am trying to do is PDF an Excel file and have it as one page wide and landscape. I don't care how many pages as long it is as long as it fits into one page width. The landscape thing works for me, it just will create the PDF on 2 or 3 pages wide and since it is a table, it isn't usable.

The entire code I have is as follows:

Option Explicit

Sub SheetsAsPDFsAllPromotions1PageWide()
Dim Sheet As Worksheet, SheetName$, MyFilePath$, N&
MyFilePath$ = "G:\Tech Writing Stuff\Templates\Project Services\" & _
Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4) & Format(Date, "MM-DD-YYYY")
With Application
.ScreenUpdating = False
.DisplayAlerts = False
On Error Resume Next '<< a folder exists
'MkDir MyFilePath '<< create a folder
For N = 1 To Sheets.Count
Sheets(N).Activate
SheetName = ActiveSheet.Name
Cells.Copy
Workbooks.Add (xlWBATWorksheet)
With ActiveWorkbook
With .ActiveSheet
.Paste
.Name = SheetName
[A1].Select
.PageSetup.Orientation = xlLandscape
.PageSetup.FitToPagesWide = 1
End With
'save book in this folder
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=MyFilePath, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
.Close SaveChanges:=False
End With
.CutCopyMode = False
Next
End With
Sheet1.Activate
End Sub

Should be a simple solution one would think.

Brent

SamT
07-11-2013, 07:33 AM
Try thisWith xlWBATWorksheet.ActiveSheet
.VPageBreaks.Add After:=Range("X1") 'where X is the last column desired

With .PageSetUp
.FitToPagesWide = 1
End With
End With

Or thisRangeWidth = Range("A1:X1").Width
PageWidth = Application.InchesToPoints(PaperLength - Margins)
ZoomValue = (PageWidth / RangeWidth) * 100
If ZoomValue > 100 Then ZoomValue = 100

.PageSetup.Zoom = ZoomValue

brent.fraser
07-11-2013, 08:13 AM
Hey SamT,

Hope all is well in Missouri today,

Thanks for your help!

it's working well now.

Have a great rest of your week and a nice weekend.

Brent