Блог

Я пытаюсь преобразовать несколько файлов 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..." amp; n amp; "/" amp; fo.Files.Count

    Set wb = Workbooks.Open(f.Path)
    
    Call Print_Settings(f, xlPaperLetter)
    
    wb.ExportAsFixedFormat xlTypePDF, sh.Range("E4").Value amp; Application.PathSeparator amp; 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. Вы должны предоставить методу Close объекта Workbook соответствующий аргумент. В противном случае вы получите запрос с вопросом, хотите ли вы сохранить книгу.

3. Ваша переменная counter n должна быть инициализирована перед For Each/Next циклом, а затем увеличена в цикле.

Вместо этого попробуйте следующее…

 n = 0 'initialize counter

For Each f In fo.Files

    n = n   1 'increment counter
        
    Application.StatusBar = "Processing..." amp; n amp; "/" amp; fo.Files.Count

    Set wb = Workbooks.Open(f.Path)
    
    Call Print_Settings(wb, xlPaperLetter)
    
    wb.ExportAsFixedFormat xlTypePDF, sh.Range("E4").Value amp; Application.PathSeparator amp; VBA.Replace(f.Name, ".xlsx", ".pdf"), quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=True
    
    wb.Close SaveChanges:=False 'change as desired
    
Next