I have part of a print procedure below. The problem is with the FitToPages... requirments.
The print works fine but after the first page is printed which is perfect, the rest all do
not fit to the page and take 3 sheets to cover the print area. I know it must be staring
me in the face but frustration is overcoming reasoned thought. I would value any help.

Graham

r = Sheets("Entries").Cells(Rows.Count, "A").End(xlUp).row

For Each c In Sheets("Entries").Range("A12:A" & r)

' check if sheet exists
If WksExists(c.Value) Then
Set rng = Sheets(c.Value).Range("a1:o48")
With Sheets(c.Value).PageSetup
.Orientation = xlLandscape
.PaperSize = xlPaperA4
.FitToPagesWide = 1
.FitToPagesTall = 1

End With
rng.PrintOut Copies:=1, Preview:=False, Collate:=True

End If
Next
End Sub

Function WksExists(wksName As String) As Boolean
On Error Resume Next
WksExists = CBool(Len(Worksheets(wksName).Name) 0)
End Function

Just for completeness if anyone has a similar problem I eventually found out the problem.
To get the printout to fit to one page wide by one page long, in the With
Sheets(c.Value).pagesetup you must also put in .zoom = false This them allows the fit to
page criteria to work. It took a long time but I got there.


Graham H wrote:
I have part of a print procedure below. The problem is with the
FitToPages... requirments. The print works fine but after the first page
is printed which is perfect, the rest all do not fit to the page and
take 3 sheets to cover the print area. I know it must be staring me in
the face but frustration is overcoming reasoned thought. I would value
any help.

Graham

r = Sheets("Entries").Cells(Rows.Count, "A").End(xlUp).row

For Each c In Sheets("Entries").Range("A12:A" & r)

' check if sheet exists
If WksExists(c.Value) Then
Set rng = Sheets(c.Value).Range("a1:o48")
With Sheets(c.Value).PageSetup
.Orientation = xlLandscape
.PaperSize = xlPaperA4
.FitToPagesWide = 1
.FitToPagesTall = 1

End With
rng.PrintOut Copies:=1, Preview:=False, Collate:=True

End If
Next
End Sub

Function WksExists(wksName As String) As Boolean
On Error Resume Next
WksExists = CBool(Len(Worksheets(wksName).Name) 0)
End Function