set print area on multiple sheets

  • Thread starter Thread starter J.W. Aldridge
  • Start date Start date
J

J.W. Aldridge

I've tried several ways to do this, but haven't been successful yet.
Need to run "printareamacro" on all sheets after Ind_brkdwn.

Sub PRINTING_PLEASE()
Dim sh As Worksheet
'for each sheet in workbook after "ind templates"
x = Sheets("IND_BRKDWN").Index
For Each sh In ThisWorkbook.Sheets
If sh.Index > x Then
Call printareamacro
End If
Next
'Application.CutCopyMode = False
End Sub
----------------------------------------------------------------------
Sub printareamacro()
Cells.Select
Cells.EntireColumn.AutoFit
Range("A1").Select

With ActiveSheet.PageSetup
.PrintArea = Range("a1").CurrentRegion.Address
.Orientation = xlLandscape
.CenterHorizontally = True
.CenterVertically = True
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1

With Selection.Font
.Name = "Arial"
.Size = 12
End With
End With
'ActiveSheet.PrintPreview
Cells.EntireColumn.AutoFit
End Sub
 
You're actually running the printareamacro against the activesheet each time
it's called.

So if you never change the activesheet, then you're just re-applying the routine
to the same sheet--over and over and over and ...

'add this just in case ThisWorkbook isn't active:
thisworkbook.activate
For Each sh In ThisWorkbook.Sheets
If sh.Index > x Then
sh.select 'changing the activesheet
Call printareamacro
End If
Next sh

=======================
Another way around it is to pass the sheet you want to use to the
printareamacro. Then you could drop the .select's. The code may be easier to
understand, too:

For Each sh In ThisWorkbook.Sheets
If sh.Index > x Then
Call printareamacro(mySh:=sh)
End If
Next sh

And the other sub changes:

Sub printareamacro(mySh as object)
with mysh
With .PageSetup
.PrintArea = .Range("a1").CurrentRegion.Address
.Orientation = xlLandscape
.CenterHorizontally = True
.CenterVertically = True
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
end with

With .cells.Font
.Name = "Arial"
.Size = 12
End With

.Cells.EntireColumn.AutoFit

'.PrintPreview

End With

End Sub
 
adjusted the two.

wrong number of arguments or invalid property assignment.




Sub printareamacro()
mySh As Object
With mySh
With .PageSetup
.PrintArea = .Range("a1").CurrentRegion.Address
.Orientation = xlLandscape
.CenterHorizontally = True
.CenterVertically = True
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With

With .Cells.Font
.Name = "Arial"
.Size = 12
End With

.Cells.EntireColumn.AutoFit
'.PrintPreview
End With
End Sub



Sub pRINT_EM()
For Each sh In ThisWorkbook.Sheets
If sh.Index > x Then
Call printareamacro(mySh:=sh)
End If
Next sh

End Sub
 
Option Explicit
Sub PRINTING_PLEASE()
Dim sh As Worksheet
Dim x As Long
'for each sheet in workbook after "ind templates"
x = Sheets("IND_BRKDWN").Index
For Each sh In ThisWorkbook.Sheets
If sh.Index > x Then
Call printareamacro(mySh:=sh)
End If
Next sh
'Application.CutCopyMode = False
End Sub
Sub printareamacro(mySh As Object)
With mySh
With .PageSetup
.PrintArea = .Parent.Range("a1").CurrentRegion.Address
.Orientation = xlLandscape
.CenterHorizontally = True
.CenterVertically = True
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With

With .Cells.Font
.Name = "Arial"
.Size = 12
End With

.Cells.EntireColumn.AutoFit
'.PrintPreview
End With
End Sub
 
Back
Top