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