Page Setup Macro

[bhrjohnson]

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]

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]

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]

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]

Dominic,
Thanks for the offer. I'll take you up on it if this macro doesn't work.
Thanks,
Bill

 

[cfree36]

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]

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]

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

 

[bhrjohnson]

Bingo!

Thanks for your help on this!

Bill

 

[just_jon]

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.