Automatically Resize Entire Workbook

WindsorKnot

Board Regular
Joined
Jan 4, 2009
Messages
160
Hi Everyone,

I have a 40+ page workbook that I'm working and I need to print every sheet in the workbook on legal size paper, and each sheet can not be > one legal piece of paper

The macro will cycle thru all the sheets in the workbook, yet it will only adjust the current active sheet. I highlighted where I think my error is in red.

Any feedback would be greatly appreciated!



Code:
Sub Print_Fit()
    
   Dim OwSheet As Worksheet
  
   For Each OwSheet In Worksheets
   
    [B][COLOR=red]With ActiveSheet.PageSetup
[/COLOR][/B]    
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    [COLOR=red][B]ActiveSheet.PageSetup[/B][/COLOR].PrintArea = ""
    With [COLOR=red][B]ActiveSheet.PageSetup
[/B][/COLOR]        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.75)
        .RightMargin = Application.InchesToPoints(0.75)
        .TopMargin = Application.InchesToPoints(1)
        .BottomMargin = Application.InchesToPoints(1)
        .HeaderMargin = Application.InchesToPoints(0.5)
        .FooterMargin = Application.InchesToPoints(0.5)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperLegal
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
        .PrintErrors = xlPrintErrorsDisplayed
    End With
    Next OwSheet
    
End Sub
 

Some videos you may like

Excel Facts

Can you AutoAverage in Excel?
There is a drop-down next to the AutoSum symbol. Open the drop-down to choose AVERAGE, COUNT, MAX, or MIN

Datsmart

Well-known Member
Joined
Jun 19, 2003
Messages
7,985
Add an Activate line after your With Statement:
Code:
    For Each OwSheet In Worksheets
        OwSheet.Activate
 

WindsorKnot

Board Regular
Joined
Jan 4, 2009
Messages
160
John,

Thank you very much! I'm still learning VBA so I really appreciate the input.:)
 

RoryA

MrExcel MVP, Moderator
Joined
May 2, 2008
Messages
36,151
Office Version
  1. 365
  2. 2019
  3. 2016
  4. 2010
Platform
  1. Windows
  2. MacOS
You could amend your code to:
Code:
Sub Print_Fit()
    
   Dim OwSheet As Worksheet
  
   For Each OwSheet In Worksheets
   
    With OwSheet.PageSetup
    
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
        .PrintArea = ""
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.75)
        .RightMargin = Application.InchesToPoints(0.75)
        .TopMargin = Application.InchesToPoints(1)
        .BottomMargin = Application.InchesToPoints(1)
        .HeaderMargin = Application.InchesToPoints(0.5)
        .FooterMargin = Application.InchesToPoints(0.5)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperLegal
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
        .PrintErrors = xlPrintErrorsDisplayed
    End With
    Next OwSheet
    
End Sub
 

WindsorKnot

Board Regular
Joined
Jan 4, 2009
Messages
160

ADVERTISEMENT

With the suggested adjustments the code runs good. The only drawback is it takes several mins to completely execute the code in large workbooks. I suppose that there isn't a solution for that?
 

Norie

Well-known Member
Joined
Apr 28, 2004
Messages
76,232
Office Version
  1. 365
Platform
  1. Windows
WindsorKnot

I think you'll find most code for setting PageSetup will be slow.

And it's normally not an Excel problem, more likely to do with your printer driver(s).:)
 

Datsmart

Well-known Member
Joined
Jun 19, 2003
Messages
7,985

ADVERTISEMENT

Try Rory's suggestion.
That should speed it up...
Let us know how it goes.
 

WindsorKnot

Board Regular
Joined
Jan 4, 2009
Messages
160
One final question: Is it possible in VBA to have the pages automatically centered so that the document is centered based on where the cells are, not just the printable area?

I.E say the data starts at normally starts at A1 but on a certain sheet doesn't start till G20. Could a module recognize this and center the document based on G20?
 

RoryA

MrExcel MVP, Moderator
Joined
May 2, 2008
Messages
36,151
Office Version
  1. 365
  2. 2019
  3. 2016
  4. 2010
Platform
  1. Windows
  2. MacOS
You could change the print area for that sheet rather than just printing the entire sheet.
The only way to really speed up the PageSetup code is to use the old Excel4 PAGE.SETUP macro but the syntax can get horrendously complicated if you are changing a lot of attributes. As Norie implied, using PageSetup actually communicates with the printer driver so there is some overhead there; PAGE.SETUP doesn't.
On the other hand, you presumably don't need to run this very often!
 

Watch MrExcel Video

Forum statistics

Threads
1,123,369
Messages
5,601,223
Members
414,434
Latest member
Riyen

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top