Macro To Zoom A Picture

[rockyw]

I found this macro that will zoom a picture; the problem is it never returns to the original size. Can this or a different macro zoom a picture, and then return the image to the original size after you click off? Or zoom if you hover over an image. I also may have the sheet protected, will it still work then? Thanks for any advice.

[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]Sub Picture_Click()
Set Shp = ActiveSheet.Shapes(Application.Caller)
Shp.Select
ActiveWindow.Zoom = 75
End Sub[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]

<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>

 

[Domenic]

Here's an alternative method, which uses the AlternativeText property of the Shape object to keep track of the zoom position...

1) Enter the following code in a regular module (Alt-F11 > Insert > Module)...

Option Explicit

Private Sub ZoomInAndOut()

    Dim Shp As Shape
    
    Set Shp = ActiveSheet.Shapes(Application.Caller)
    
    If Shp.AlternativeText = "150% Zoom" Then
        Shp.ScaleHeight 2 / 3, msoFalse
        Shp.ScaleWidth 2 / 3, msoFalse
        Shp.AlternativeText = "100% Zoom"
    Else
        Shp.ScaleHeight 1.5, msoFalse
        Shp.ScaleWidth 1.5, msoFalse
        Shp.AlternativeText = "150% Zoom"
    End If

End Sub

2) For each shape/picture on any sheet within the workbook, assign the above macro by right-clicking on the shape/picture, selecting 'Assign Macro', entering the macro name, and clicking OK. So, for example, if the above macro has been placed in Module1, the macro name should be entered as Module1.ZoomInAndOut

Hope this helps!

 

[Supporter13]

i know a lot of time has passed since last post but a nice addition to he code would be to make zoomed images go to the front. so if you have a lot of images together when you zoom the images goes to the front so is completely visible