VBA Code to Bulk Edit Multiple Files in a Folder Structure Page Layouts to 1 page

[westlabanker]

Hello,

I would like some assistance with a VBA code that can edit all the excel files in a folder structure to change the page layouts for all the sheets to 1 pages wide and tall. I have been trying a couple different options and cant seem to find one that works effectively.

Thank you in advance and I will be quick with my questions/comments!

 

[John_w]

Try this macro - I would test it on a subset of a copy of your folder structure. As written, the macro changes the page layouts of all sheets in all workbook files matching "*.xlsx" in the folder tree starting at the specified folder.

I found that disabling communication with the printer, Application.PrintCommunication = False, is necessary for every sheet, otherwise the page layout change doesn't persist in the saved workbook.

Option Explicit

Public Sub Change_Page_Layouts_All_Workbooks()
        
    Application.ScreenUpdating = False
    Change_Page_Layouts_Workbooks_In_Folders "C:\path\to\folder", "*.xlsx"
    Application.ScreenUpdating = True
    MsgBox "Done"
    
End Sub


Private Sub Change_Page_Layouts_Workbooks_In_Folders(folderPath As String, matchFiles As String)
   
    Static FSO As Object
    Dim Folder As Object, Subfolder As Object, File As Object
    Dim wb As Workbook, ws As Worksheet
    
    If FSO Is Nothing Then Set FSO = CreateObject("Scripting.FileSystemObject")

    'Process matching files in this folder
    
    Set Folder = FSO.GetFolder(folderPath)
    For Each File In Folder.Files
        If LCase(File.Name) Like LCase(matchFiles) Then
            Set wb = Workbooks.Open(File.Path)
            For Each ws In wb.Worksheets
                'Must disable communication with the printer for each sheet, otherwise Page Layout change doesn't persist in saved workbook
                Application.PrintCommunication = False
                ws.PageSetup.FitToPagesWide = 1
                ws.PageSetup.FitToPagesTall = 1
                Application.PrintCommunication = True
            Next
            wb.Close SaveChanges:=True
        End If
    Next
    
    'Process matching files in subfolders
    
    For Each Subfolder In Folder.SubFolders
        Change_Page_Layouts_Workbooks_In_Folders Subfolder.Path, matchFiles
    Next
    
End Sub