VBA | With opening/activating sheet > edit viewing screen/zoom

Question

When I activate a sheet I want excel to do the following process:

Is cell "A1 and cell "Z1" in the range of my screen?

Yes: Do nothing

No:

Range("A1:Z1").Select
ActiveWindow.Zoom = True

I want this because my file has to open on different screens/screen resolutions and everything has to be visible for everyone.

I hope somebody can help me.

couldn't you just do it (`Range("A1:Z1").Select` & `ActiveWindow.Zoom = True`) in any case? — user3598756, Dec 08 '16 at 09:03
@user3598756 I Couldn't, because at some screens with large resolution the text would be very big. — Tim van Mechelen, Dec 08 '16 at 09:28

score 0 · Answer 1 · answered Dec 08 '16 at 08:55

From the link i posted in the comment, i have come up with this code

Sub temp()

    Dim zoomRatio As Integer
    zoomRatio = 100

    Do While (Not (CellIsInVisibleRange(ActiveSheet.Range("Z1"))))
        zoomRatio = zoomRatio - 1
        ActiveWindow.Zoom = zoomRatio
    Loop

End Sub


Function CellIsInVisibleRange(cell As Range)
    CellIsInVisibleRange = Not Intersect(ActiveWindow.VisibleRange, cell) Is Nothing
End Function

Update:

Revised the subroutine to Zoom in if more than column Z is visible and Zoom out if less than Col Z is visible

Sub temp()

    Dim zoomRatio As Integer
    zoomRatio = ActiveWindow.Zoom

    Do While (Not (CellIsInVisibleRange(ActiveSheet.Range("Z1"))))
        zoomRatio = zoomRatio - 2
        ActiveWindow.Zoom = zoomRatio
    Loop

    Do While (CellIsInVisibleRange(ActiveSheet.Range("AA1")))
        zoomRatio = zoomRatio + 2
        ActiveWindow.Zoom = zoomRatio
    Loop

End Sub

This doesn't work. My worksheet keeps zooming out till my excel crashes... — Tim van Mechelen, Dec 08 '16 at 09:32

score 0 · Answer 2 · answered Dec 08 '16 at 09:43

I fixed it. Thank you!

Private Sub Worksheet_Activate()

If CellIsInVisibleRange(ActiveSheet.Range("Z2")) Then

'Nothing
Else
    Range("A2:Z2").Select
    ActiveWindow.Zoom = True
    Range("D3").Select
End If

End Sub

Function CellIsInVisibleRange(cell As Range)

CellIsInVisibleRange = Not Intersect(ActiveWindow.VisibleRange, cell) Is Nothing

End Function

score 0 · Accepted Answer · answered Dec 08 '16 at 10:53

Couldn't you just check if the range already fits and if it doesn't call the zoom method?

Option Explicit

Public Sub RunMe()
    FitColumns "A:Z"
End Sub

Private Sub FitColumns(addr As String)
    Dim oldSel As Range
    Dim colRange As Range

    Set oldSel = Selection
    Set colRange = Range(addr).Resize(1)
    If Intersect(colRange, ActiveWindow.VisibleRange) Is Nothing Then
        colRange.Select
        ActiveWindow.Zoom = True
        oldSel.Select
    End If
End Sub

Sorry, missed your answer appearing while I wrote. – Ambie Dec 08 '16 at 10:58 — Ambie, Dec 08 '16 at 10:58

VBA | With opening/activating sheet > edit viewing screen/zoom

3 Answers3