Page Setup Macro

bhrjohnson

Board Regular
Joined
Oct 8, 2004
Messages
56
Is there a simple macro I can use to apply a page setup specification to ALL worksheets in a workbook? I have about 75 worksheets so it would take a while to do manually. I want to apply "Fit to 1 page wide" while leaving the "pages tall" category empty. I would also like to reduce the righthand margin and top & botton margins on each page as much as possible to maximize printing area. Any ideas?

Thanks,
Bill
 

DominicB

Well-known Member
Joined
Oct 3, 2005
Messages
1,569
Good evening bhrjohnson

I have an add-in available free to anyone who requests it. One of the utilities contained will copy any selected print settings from any source sheet to any number of destination sheets. It can also copy print settings across different workbooks. please let me know if you want a copy.

HTH

DominicB
dominic@dom-and-lis.co.uk
 

cfree36

Board Regular
Joined
Oct 5, 2005
Messages
175
Sub PageSetUp()
Dim ws As Worksheet

For Each ws In ActiveWorkbook.Worksheets
ActiveSheet.PageSetUp.PrintArea = ""
With ActiveSheet.PageSetUp
.LeftMargin = Application.InchesToPoints(0.25)
.RightMargin = Application.InchesToPoints(0.25)
.TopMargin = Application.InchesToPoints(0.25)
.BottomMargin = Application.InchesToPoints(0.25)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.FitToPagesWide = 1
.FitToPagesTall = False
End With
Next ws
End Sub
 

bhrjohnson

Board Regular
Joined
Oct 8, 2004
Messages
56
cfree36,

That macro makes sense and when I ran it something was certainly happening but I'm not sure what. The same worksheet stayed visible but flashed for quite a while. However, it does not seem to have changed the margins or the print formatting to fit to 1 page wide.

Any thoughts on what might be wrong?

Here's what I'm using...

Sub PageSetUp()
Dim ws As Worksheet

For Each ws In ActiveWorkbook.Worksheets
ActiveSheet.PageSetUp.PrintArea = ""
With ActiveSheet.PageSetUp
.LeftMargin = Application.InchesToPoints(0.75)
.RightMargin = Application.InchesToPoints(0.25)
.TopMargin = Application.InchesToPoints(0.25)
.BottomMargin = Application.InchesToPoints(0.25)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.FitToPagesWide = 1
.FitToPagesTall = False
End With
Next ws
End Sub
 

bhrjohnson

Board Regular
Joined
Oct 8, 2004
Messages
56
Dominic,
Thanks for the offer. I'll take you up on it if this macro doesn't work.
Thanks,
Bill
 

cfree36

Board Regular
Joined
Oct 5, 2005
Messages
175
Try this version....

Sub PageSetUp()
Dim ws As Worksheet

For Each ws In ActiveWorkbook.Worksheets
If ws.Visible = True Then
ws.Select
ActiveSheet.PageSetUp.PrintArea = ""
With ActiveSheet.PageSetUp
.LeftMargin = Application.InchesToPoints(0.75)
.RightMargin = Application.InchesToPoints(0.25)
.TopMargin = Application.InchesToPoints(0.25)
.BottomMargin = Application.InchesToPoints(0.25)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.FitToPagesWide = 1
.FitToPagesTall = False
End With
End If
Next ws
End Sub
 

bhrjohnson

Board Regular
Joined
Oct 8, 2004
Messages
56
Getting closer. It looks like the margins are correct now but the "Fit by 1 page wide" doesn't seem to be working.

Any suggestions?
 

cfree36

Board Regular
Joined
Oct 5, 2005
Messages
175
Sub PageSetUp()
Dim ws As Worksheet

For Each ws In ActiveWorkbook.Worksheets
If ws.Visible = True Then
ws.Select
ActiveSheet.PageSetUp.PrintArea = ""
With ActiveSheet.PageSetUp
.LeftMargin = Application.InchesToPoints(0.75)
.RightMargin = Application.InchesToPoints(0.25)
.TopMargin = Application.InchesToPoints(0.25)
.BottomMargin = Application.InchesToPoints(0.25)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
End With
End If
Next ws
End Sub
 

just_jon

Legend
Joined
Sep 3, 2002
Messages
10,473
In that macro, put

Application.Screenupdating=False

at the top, and at the botton

Application.screenupdating=True

Will stop the flicker.

You could also, if you wished, return to the original sheet.
 

Forum statistics

Threads
1,077,926
Messages
5,337,242
Members
399,134
Latest member
ChetManley

Some videos you may like

This Week's Hot Topics

Top