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

Question

我正在尝试将文件夹中的多个 excel 文件转换为 PDF。 我创建了一个宏，可以将 excel 文件转换为 PDF 并格式化第一页。

我试图让它为每个页面格式化它，但我没有任何运气。

我已经为每个循环尝试了一些，但似乎不起作用。

单元格 E4 和 E3 是位于主宏工作簿第一个工作表中的文件的位置。

有什么建议？

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

首先，您需要更改Print_Settings()的签名，以便它接受 Workbook 对象，而不是 File 对象...

Sub Print_Settings(wb As Workbook, ePaperSize As XlPaperSize)

然后您可以使用For Each/Next循环遍历每个工作表...

For Each ws In wb.Worksheets
    'etc
    '
    '
Next ws

所以Print_Settings()将如下...

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

然后您可以按如下方式调用该过程...

Call Print_Settings(wb, xlPaperLetter)

其他注意事项

1. 您可以删除对Print_Settings()的第二次调用，因为它似乎是多余的。

2. 您应该为 Workbook 对象的 Close 方法提供适当的参数。 否则，您将收到询问是否要保存工作簿的提示。

3. 您的计数器变量n应该在For Each/Next循环之前初始化，然后在循环内递增。

请尝试以下操作...

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