Excel vba code to format multiple workbooks for printing
Extend Office has Visual Basic code posted here, which can be used to run one macro on multiple workbooks. The below variation of this code will process multiple Excel spreadsheets saved in a single folder, and prepare them to be printed. The vba code will set the workbooks so that:
- all columns fit on a single page
- landscape orientation is set
- the first row repeats at the top of each page
- the name of the Excel file appears in the footer
Insert the code in a module of a blank workbook. When it's run it will prompt you to select a folder with the files to process.
![](https://static.wixstatic.com/media/af7fa4_e0d24e6eb9534e81a3e5f0bd75a80aed~mv2.png/v1/fill/w_980,h_665,al_c,q_90,usm_0.66_1.00_0.01,enc_auto/af7fa4_e0d24e6eb9534e81a3e5f0bd75a80aed~mv2.png)
The macro will open each file and set the specified formatting settings.
![](https://static.wixstatic.com/media/af7fa4_42ad33e29247415896a2d7e792d0af56~mv2.png/v1/fill/w_980,h_747,al_c,q_90,usm_0.66_1.00_0.01,enc_auto/af7fa4_42ad33e29247415896a2d7e792d0af56~mv2.png)
The files will not be saved automatically, but you can do this by holding down the SHIFT key and clicking the X to close Excel. You will be prompted to save all of the files.
![](https://static.wixstatic.com/media/af7fa4_b6a63bd2e13e452998e6079bd06b66e3~mv2.png/v1/fill/w_683,h_361,al_c,q_85,enc_auto/af7fa4_b6a63bd2e13e452998e6079bd06b66e3~mv2.png)
Sub LoopThroughFiles()
Dim xFd As FileDialog
Dim xFdItem As Variant
Dim xFileName As String
Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
If xFd.Show = -1 Then
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.xls*")
Do While xFileName <> ""
With Workbooks.Open(xFdItem & xFileName)
'your code here
Dim ws As Worksheet
Application.PrintCommunication = False
For Each ws In ActiveWorkbook.Worksheets
With ws.PageSetup
.Zoom = False
.PrintTitleRows = "$1:$2"
.FitToPagesWide = 1
.FitToPagesTall = 1000
.Orientation = xlLandscape
.CenterFooter = "&F"
End With
Next ws
End With
xFileName = Dir
Loop
End If
End Sub
Comments