Page setup VBA help please

[Jack Sheet]

I would like a macro that determines the extent of shrinkage that would be
achieved under three different page setups:
Setup 1: Portrait mode, shrink to 1 page
Setup 2: Landscape mode, shrink to 1 page
Setup 3: Landscape mode, shrink to 1 page wide by infinite pages high
(or very large number if infinite not possible - the manual page setup
screen does not seem to allow for infinite pages high by 1 wide).

Having idenfified these three constants I want it automatically to set the
appropriate setup according to the following rules.
Whichever of setups 1 or 2 that results in the most shrinkage (smallest
text) is discarded as inappropriate.
Of the remaining (undiscarded) page setup between 1 and 2, this is also
discarded as unsuitable if the resulting shrinkage is more than a predefined
constant (say, 60% of original size or smaller). If the shrinkage is less
(ie more than 60% of original size) then setup 3 is discarded, but it the
shrinkage is excessive we adopt setup 3.

I hope all that is clear to the reader, but I am a bit lost. Hopefully this
is not reinventing the wheel, as it seems like a useful macro that I would
regularly use in several workbooks.

Thanks for any help.

 

[Bill Renaud]

I used the macro recorder to give you a quick idea of the properties that
you need to be working with. Basically, you would set the Orientation to a
value (as in the 4 examples below), then fetch the Zoom property (it will
be a Variant from 10 to 400 or False). After getting the Zoom level for
each of your 3 Setups, check to see which one is the largest, then decide
what to do.

The FitToPages properties (FitToPagesWide and FitToPagesTall) can either be
set to a number, or to False. Normally, you set FitToPagesTall to False
(clear the value in the drop-down combo box in the File|Page Setup dialog
box) to enable the worksheet to span multiple pages. This is how I recorded
the SetLandscape1Wide routine below.

'----------------------------------------
Sub SetPortrait1()
With ActiveSheet.Page
.Orientation = xlPortrait
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
End Sub

'----------------------------------------
Sub SetLandscape1()
With ActiveSheet.PageSetup
.Orientation = xlLandscape
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
End Sub

'----------------------------------------
Sub SetLandscape1Wide()
With ActiveSheet.PageSetup
.Orientation = xlLandscape
.FitToPagesWide = 1
.FitToPagesTall = False
End With
End Sub

'----------------------------------------
Sub SetZoom()
With ActiveSheet.PageSetup
.Orientation = xlLandscape
.Zoom = 75
End With
End Sub

 

[Jack Sheet]

Thanks for trying it out, Bill.

Unfortunately it does not quite get there, and the last inch is the b*gger.

The problem is that setting to a single page sets zoom to false, so the
actual zoom characteristics cannot be interrogated directly.

I have been given a couple of solutions on a rival site that I am having a
play around with. One makes use of the excel 4 macro GET.DOCUMENT(50) and
the other makes liberal use of sendkeys, so they are both pretty yucky, but
I guess it is the best available.

 

[Bill Renaud]

<<The problem is that setting to a single page sets zoom to false, so the
actual zoom characteristics cannot be interrogated directly.>>

Unfortunately, I believe this is correct (after doing some more testing
myself).

According the XLMACRO help file (an Excel 2000 Help file that documents the
XLM 4 macro functions), it appears that you should use either
GET.DOCUMENT(62) or GET.DOCUMENT(63). I set up the following code, and it
returns 1 (100%) in all cases. I could never get it to tell me what the
actual scaling size was.

I think I would probably resort to checking the sum of the column widths
and row heights in the UsedRange for the worksheet, then doing my own
calculations to determine how to set the PageSetup properties. This
technique would actually be faster, as the PageSetup object is quite slow
in VBA anyway.

Let us know if you find out something better.

'----------------------------------------------------------------------
Public Sub SetPageSetup()
Dim wsActive As Worksheet
Dim varZoom1 As Variant
Dim varZoom2 As Variant
Dim varZoom3 As Variant

Set wsActive = ActiveSheet

varZoom1 = PageZoom(wsActive, xlPortrait, 1, 1)
varZoom2 = PageZoom(wsActive, xlLandscape, 1, 1)
varZoom3 = PageZoom(wsActive, xlLandscape, 1, False)
End Sub

'----------------------------------------------------------------------
'ExecuteExcel4Macro("Get.Document(62)")
'Percentage of reduction or enlargement, or 100% if none is specified.
'Returns the #N/A error value if not supported by the current printer
'or if the document is a chart.

'ExecuteExcel4Macro("Get.Document(63)")
'A two-item horizontal array indicating the number of pages to which
'the printout should be scaled to fit, with the first item equal
'to the width (or #N/A if no width scaling is specified) and the
'second item equal to the height (or #N/A if no height scaling is
'specified). #N/A is also returned if the document is a chart.

Public Function PageZoom(ws As Worksheet, _
PageOrientation As XlPageOrientation, _
PagesWide As Variant, _
PagesTall As Variant) As Variant

Dim varZoom62 As Variant
Dim varZoom63 As Variant

ws.Activate

With ws.PageSetup
'Do PageSetup according to input parameters.
.Orientation = PageOrientation
.Zoom = False
.FitToPagesWide = PagesWide
.FitToPagesTall = PagesTall

'Now determine what Zoom level resulted.
varZoom62 = ExecuteExcel4Macro("Get.Document(62)")
varZoom63 = ExecuteExcel4Macro("Get.Document(63)")

If Not IsError(varZoom62) _
Then
PageZoom = varZoom62
Exit Function
End If

If Not IsError(varZoom63) _
Then
PageZoom = varZoom63
Exit Function
Else
PageZoom = CVErr(xlErrNA)
End If
End With
End Function