Zoom to fit Columns

[Sisilla]

Hello All,

I want to set Zoom so that all columns can fit in one page. First, I
sum the widths of the visible columns on the page between A and O and
convert the measurement to inches. I then set the Orientation,
PaperSize and Zoom based on the measurement. I am using the following
code-:

Dim cw As Double

Dim Counter As Long
For Counter = 1 To 15
If
Sheets("Application").Columns(Counter).EntireColumn.Hidden = False
Then
cw = cw + Sheets("Application").Columns(Counter).Width
End If
Next Counter

cw = cw / 72

If cw > 0 And cw <= 8 Then
Sheets("Application").PageSetup.Orientation = xlPortrait
Sheets("Application").PageSetup.PaperSize = xlPaperLetter
Sheets("Application").PageSetup.Zoom =
WorksheetFunction.RoundDown(700 / cw, 0)
Else
If cw > 8 And cw <= 11 Then
Sheets("Application").PageSetup.Orientation =
xlLandscape
Sheets("Application").PageSetup.PaperSize =
xlPaperLetter
Sheets("Application").PageSetup.Zoom =
WorksheetFunction.RoundDown(1000 / cw, 0)
Else
If cw > 11 Then
Sheets("Application").PageSetup.Orientation =
xlLandscape
Sheets("Application").PageSetup.PaperSize =
xlPaperLegal
Sheets("Application").PageSetup.Zoom =
WorksheetFunction.RoundDown(1300 / cw, 0)
End If
End If
End If

If my calculations are correct, this code should work fine, but I have
been encountering problems. When cw = 14.76 inches, for example, the
zoom is 88%, but this zoom results in the last column being printed in
a spearate sheet. Theoretically, this Zoom should work since 88% of
14.76 is 13, so all the columns should fit fine on a legal-sized,
landscape-oriented page, but maybe I am not understanding clearly how
Zoom works.

I should note that the left and right margins have been set to zero.
What am I doing wrong here? I appreciate any effort to help me. Thank
you for your time and consideration.

Sincerely,

Sisilla

 

[JE McGimpsey]

Can you not choose File/Page Setup/Page, click the Fit to: radio button
and enter 1 in the "column wide" input box?

Programmatically, that's

With Sheets("Application").PageSetup
.Orientation = Iif(cw <= 8, xlPortrait, xlLandscape)
.PaperSize = Iif(cw <= 11, xlPaperLetter, xlPaperLegal)
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
End With

 

[Sisilla]

Can you not choose File/Page Setup/Page, click the Fit to: radio button
and enter 1 in the "column wide" input box?

Programmatically, that's

With Sheets("Application").PageSetup
.Orientation = Iif(cw <= 8, xlPortrait, xlLandscape)
.PaperSize = Iif(cw <= 11, xlPaperLetter, xlPaperLegal)
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
End With



- Show quoted text -

ROTFLMAO

Are you kidding me, JE? Is it really that simple? I can't believe it!
I am blushing over here thinking of how stupid I am. Thanks for the
tip! I greatly appreciate it. -Sisilla

 

[CLR]

Hi Sisilla.....

I was looking to do a similar thing, not printing, just screen display, and
found the below old post from Jim Thomlinson which led me to a final macro
combining your code with the results of his........

Sub SetScreenZoom()
'==============================================
'Automatically adjusts the ActiveWindow.zoom to accomodate the actual
resolution in use
'==============================================
Dim cw As Double
Dim Counter As Long
For Counter = 1 To 15 'columns A to O
If ActiveSheet.Columns(Counter).EntireColumn.Hidden = False Then
cw = cw + ActiveSheet.Columns(Counter).WIDTH
End If
Next Counter
cw = cw / 72
MsgBox GetScreenResolution & " / " & cw
ActiveWindow.zoom = GetScreenResolution / (cw * 0.95)
End Sub

@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
This from Jim's post
Here is an API to give you the Screen Resolution. Place this in a regular
module. This should be a start anyway.

Type RECT
x1 As Long
y1 As Long
x2 As Long
y2 As Long
End Type
' NOTE: The following declare statements are case sensitive.
Declare Function GetDesktopWindow Lib "user32" () As Long
Declare Function GetWindowRect Lib "user32" _
(ByVal hWnd As Long, rectangle As RECT) As Long
'*******************************************
' FUNCTION: GetScreenResolution()
'
' PURPOSE:
' To determine the current screen size or resolution.
'
' RETURN:
' The current screen resolution. Typically one of the following:
' 640 x 480
' 800 x 600
' 1024 x 768
'
' AUTHOR:
' Tom Ogilvy
'************************************************
Public Function GetScreenResolution() As String
Dim R As RECT
Dim hWnd As Long
Dim RetVal As Long

hWnd = GetDesktopWindow()
RetVal = GetWindowRect(hWnd, R)
GetScreenResolution = (R.x2 - R.x1) & "x" & (R.y2 - R.y1)
End Function

Sub test()
MsgBox GetScreenResolution
End Sub

HTH...
Jim Thomlinson
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@


It did the trick for me, hope it helps you............

Vaya con Dios,
Chuck, CABGx3

 

[Sisilla]

That's cool, CLR. I'm glad to hear that my code wasn't completely
useless!

Cheers,

Sisilla