Gradual Zoom?

[Sully1440]

Hi All,
Is there a method to gradually zoom out?

Sub test()

Application.WindowState = xlMaximized

With Sheets("Sheets1")
For i = 100 to Application.WindowState
ActiveWindow.Zoom = i
Next i

End With
End Sub


....Also, is there a way to zoom back to the original size?

[p45cal]

gradually

…over time or with user interaction?

Also, are you confusing the size of the window with the zoom factor (magnification)?

[Sully1440]

Hi,
Over time, I'd like a gradual zoom out after the user selects the a macro.

I'd like it to go from current zoom state to view max zoom to include a entire view but in a gradual increment.

[Paul_Hossler]

Do you want to have it just shrink back to original size (you have a look in the example) or be something caused by user action?


Maybe zoomOutGrow() below might be what you're looking for

Option Explicit

Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Const zoomIncrement As Long = 10
Public zoomOriginal As Long
 
Public Sub zoomOut()
    'remember
    If zoomOriginal = 0 Then zoomOriginal = ActiveWindow.Zoom
    ActiveWindow.Zoom = ActiveWindow.Zoom - zoomIncrement
End Sub


Public Sub zoomIn()
    'remember
    If zoomOriginal = 0 Then zoomOriginal = ActiveWindow.Zoom
    ActiveWindow.Zoom = ActiveWindow.Zoom + zoomIncrement
End Sub

Public Sub zoomReset()
    'remember
    If zoomOriginal = 0 Then
        ActiveWindow.Zoom = 100
    Else
        ActiveWindow.Zoom = zoomOriginal
        zoomOriginal = 0
    End If
End Sub


Public Sub zoomOutGrow()
    
    Do While ActiveWindow.Zoom > 100
        ActiveWindow.Zoom = ActiveWindow.Zoom - 1
        Sleep 100           '   1/10 sec
        DoEvents
    Loop
End Sub

[Paul_Hossler]

Hi,
Over time, I'd like a gradual zoom out after the user selects the a macro.

I'd like it to go from current zoom state to view max zoom to include a entire view but in a gradual increment.

So if current zoom state = 120%, how do you define max zoom?

What is 'entire view'? Columns A to last one with data?

[Sully1440]

…over time or with user interaction?

Also, are you confusing the size of the window with the zoom factor (magnification)?

[Sully1440]

Hi Paul,
This works great. Outgrow is what I'm looking for. One last question, is there a way to zoom out to only show what's on the sheet using the code below?

Public Sub zoomOutGrow2()
Do While ActiveWindow.Zoom > 20
ActiveWindow.Zoom = ActiveWindow.Zoom - 1
'Sleep 100 ' 1/10 sec
DoEvents
Loop
End Sub

Public Sub zoomInGrow2()
Do While ActiveWindow.Zoom < 70
ActiveWindow.Zoom = ActiveWindow.Zoom + 1
'Sleep 100 ' 1/10 sec
DoEvents
Loop
End Sub

[Paul_Hossler]

You can try this

Note that if you have data in A:K (the ws .UsedRange) but that only fills 1/2 the screen, the zoom will fit A:K across the screen -- is that what you want?

Option Explicit

Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Public Sub zoomOutGrow()
    Dim zoomSelection As Long, zoomOriginal As Long
    Dim oSelection As Object
    
    'remember start zoom
    zoomOriginal = ActiveWindow.Zoom
    
    'remember what was selected
    Set oSelection = Selection
    
    'zoom to data
    Application.ScreenUpdating = False
    ActiveSheet.UsedRange.EntireColumn.Select
    ActiveWindow.Zoom = True
    zoomSelection = ActiveWindow.Zoom
    ActiveWindow.Zoom = zoomOriginal
    Application.ScreenUpdating = True
    
    
    If zoomSelection > ActiveWindow.Zoom Then
        Do While ActiveWindow.Zoom < zoomSelection
            ActiveWindow.Zoom = ActiveWindow.Zoom + 1
            Sleep 100           '   1/10 sec
            DoEvents
        Loop

    ElseIf zoomSelection < ActiveWindow.Zoom Then
        Do While ActiveWindow.Zoom > zoomSelection
            ActiveWindow.Zoom = ActiveWindow.Zoom - 1
            Sleep 100           '   1/10 sec
            DoEvents
        Loop
    End If
    
    oSelection.Select
End Sub

[Sully1440]

Yes, this works. Thanks Paul. Much appreciated.