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

VBA for to convert Excel to PDF using landscape format

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

我正在尝试让它为每个页面设置格式,但我运气不好。

我已经尝试了很多 for each 循环,但它似乎不起作用。

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

有什么建议吗?


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

首先,您需要更改 Print_Settings() 的签名,以便它接受工作簿对象,而不是文件对象...

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