VBA 用于使用横向格式将 Excel 转换为 PDF

Question

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

Answer 1

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

1. You can remove the second call to Print_Settings() , since it seems redundant.

2. 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.

3. 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