I am trying to convert a number of excel files in a folder to PDF. I have created a macro that converts the excel files to PDF and formats the the first page.
I am trying to get it to format it for each page but I am not having any luck.
I've tried a number of for each loops but it doesn't seem to work.
Cells E4 & E3 are the locations of the files that are located in the first sheet of the main macro workbook.
Any suggestions?
Sub Convert_ExceltoPDF()
Application.DisplayStatusBar = True
Application.ScreenUpdating = False
Dim sh As Worksheet
Dim fso As New FileSystemObject
Dim fo As Folder
Dim f As File
Dim n As Integer
Dim x As Integer
Dim wb As Workbook
Dim I As Long
Set sh = ThisWorkbook.Sheets("Sheet1")
Set fo = fso.GetFolder(sh.Range("E3").Value)
For Each f In fo.Files
n = n
Application.StatusBar = "Processing..." & n & "/" & fo.Files.Count
Set wb = Workbooks.Open(f.Path)
Call Print_Settings(f, xlPaperLetter)
wb.ExportAsFixedFormat xlTypePDF, sh.Range("E4").Value & Application.PathSeparator & VBA.Replace(f.Name, ".xlsx", ".pdf"), quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=True
Call Print_Settings(f, xlPaperLetter)
wb.Close
Next
Application.StatusBar = ""
MsgBox "Process Complete"
End Sub
Sub Print_Settings(f As File, ePaperSize As XlPaperSize)
On Error Resume Next
Application.PrintCommunication = False
With 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
PaperSize = ePaperSize
Zoom = False
FitToPagesWide = 1
FitToPagesTall = 1
End With
Application.PrintCommunication = True
End Sub
First, you'll need to change the signature for Print_Settings()
so that it accepts a Workbook object, instead of a File object...
Sub Print_Settings(wb As Workbook, ePaperSize As XlPaperSize)
Then you can loop through each worksheet using a For Each/Next
loop...
For Each ws In wb.Worksheets
'etc
'
'
Next ws
So Print_Settings()
would be as follows...
Sub Print_Settings(wb As Workbook, ePaperSize As XlPaperSize)
Dim ws As Worksheet
'On Error Resume Next
Application.PrintCommunication = False
For Each ws In wb.Worksheets
With ws.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
.PaperSize = ePaperSize
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
Next ws
Application.PrintCommunication = True
End Sub
Then you can call the procedure as follows...
Call Print_Settings(wb, xlPaperLetter)
Other Considerations
You can remove the second call to Print_Settings()
, since it seems redundant.
You should supply the Close method of the Workbook object with the appropriate argument. Otherwise, you'll get a prompt asking whether you want the workbook saved.
Your counter variable n
should be initialized before the For Each/Next
loop, and then incremented within the loop.
Try the following instead...
n = 0 'initialize counter
For Each f In fo.Files
n = n + 1 'increment counter
Application.StatusBar = "Processing..." & n & "/" & fo.Files.Count
Set wb = Workbooks.Open(f.Path)
Call Print_Settings(wb, xlPaperLetter)
wb.ExportAsFixedFormat xlTypePDF, sh.Range("E4").Value & Application.PathSeparator & VBA.Replace(f.Name, ".xlsx", ".pdf"), quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=True
wb.Close SaveChanges:=False 'change as desired
Next