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. :)