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]

How about something like this? When you click on your picture, its size increases 50% (or some other chosen number). And when you again click on your picture, it returns to its original size. If so, insert the following code in the sheet module for the sheet containing the picture (right-click the sheet tab, and select 'View Code')...

[font=Courier New][color=darkblue]Option[/color] [color=darkblue]Explicit[/color]

[color=darkblue]Private[/color] [color=darkblue]Sub[/color] Picture_Click()

    [color=darkblue]Static[/color] Dict [color=darkblue]As[/color] Dictionary
    [color=darkblue]Static[/color] MyPics() [color=darkblue]As[/color] [color=darkblue]Variant[/color]
    [color=darkblue]Static[/color] Cnt [color=darkblue]As[/color] [color=darkblue]Long[/color]
    [color=darkblue]Static[/color] c [color=darkblue]As[/color] [color=darkblue]Long[/color]
    
    [color=darkblue]Dim[/color] Shp [color=darkblue]As[/color] Shape
    
    Cnt = Cnt + 1
    
    [color=darkblue]If[/color] Cnt = 1 [color=darkblue]Then[/color]
        [color=darkblue]Set[/color] Dict = CreateObject("Scripting.Dictionary")
    [color=darkblue]End[/color] [color=darkblue]If[/color]
    
    [color=darkblue]Set[/color] Shp = Me.Shapes(Application.Caller)
    
    [color=darkblue]If[/color] [color=darkblue]Not[/color] Dict.Exists(Shp.Name) [color=darkblue]Then[/color]
        c = c + 1
        Dict.Add Shp.Name, c
        [color=darkblue]ReDim[/color] [color=darkblue]Preserve[/color] MyPics(1 [color=darkblue]To[/color] 2, 1 To c)
        MyPics(1, c) = Shp.Name
        MyPics(2, c) = [color=darkblue]True[/color]
    [color=darkblue]End[/color] [color=darkblue]If[/color]
    
    [color=darkblue]If[/color] MyPics(2, Dict.Item(Shp.Name)) = [color=darkblue]True[/color] [color=darkblue]Then[/color]
        MyPics(2, Dict.Item(Shp.Name)) = [color=darkblue]False[/color]
        Shp.ScaleHeight 1.5, msoTrue [COLOR="Green"]'increase height by 50%[/COLOR]
        Shp.ScaleWidth 1.5, msoTrue [COLOR="Green"]'increase width by 50%[/COLOR]
    [color=darkblue]Else[/color]
       MyPics(2, Dict.Item(Shp.Name)) = [color=darkblue]True[/color]
        Shp.ScaleHeight 1, msoTrue [COLOR="Green"]'scale to original height[/COLOR]
        Shp.ScaleWidth 1, msoTrue [COLOR="Green"]'scale to original width[/COLOR]
    [color=darkblue]End[/color] [color=darkblue]If[/color]

End [color=darkblue]Sub[/color]

[/font]

Now, assign 'Picture_Click' as the macro for your picture (right-click the picture, select 'Assign Macro', and select 'Picture_Click'). If you have more than one picture that you'd like to re-size, assign each picture with the macro 'Picture_Click'. If you have many pictures, you can use the following macro that needs to be place in a regular module to assign 'Picture_Click' to all pictures on your worksheet...

[font=Courier New][color=darkblue]Sub[/color] AssignMacro()
    [color=darkblue]Dim[/color] Shp [color=darkblue]As[/color] Shape
    [color=darkblue]For[/color] [color=darkblue]Each[/color] Shp [color=darkblue]In[/color] Sheet1.Shapes [color=green]'change the sheet name accordingly[/color]
        [color=darkblue]If[/color] Shp.Type = 13 [color=darkblue]Then[/color] [color=green]'picture[/color]
            Shp.OnAction = "Sheet1.Picture_Click"
        [color=darkblue]End[/color] [color=darkblue]If[/color]
    [color=darkblue]Next[/color] Shp
[color=darkblue]End[/color] [color=darkblue]Sub[/color]
[/font]

Lastly, in case you or some user saves the workbook when your picture or pictures are at an increased size, the following will ensure that they're re-sized to their original sizes when the workbook is opened...

In a regular module:

[font=Courier New][color=darkblue]Sub[/color] ResetToOriginalSize()
    [color=darkblue]Dim[/color] Shp [color=darkblue]As[/color] Shape
    [color=darkblue]For[/color] [color=darkblue]Each[/color] Shp [color=darkblue]In[/color] Sheet1.Shapes
        [color=darkblue]If[/color] Shp.Type = 13 [color=darkblue]Then[/color] [color=green]'picture[/color]
            Shp.ScaleHeight 1, msoTrue 'scale to original height
            Shp.ScaleWidth 1, msoTrue [color=green]'scale to original width[/color]
        [color=darkblue]End[/color] [color=darkblue]If[/color]
    [color=darkblue]Next[/color] Shp
[color=darkblue]End[/color] [color=darkblue]Sub[/color]
[/font]

In the code module for 'ThisWorkbook' (double-click the icon for 'ThisWorkbook' in the Project Explorer window)...

[font=Courier New][color=darkblue]Private[/color] [color=darkblue]Sub[/color] Workbook_Open()
    [color=darkblue]Call[/color] ResetToOriginalSize
[color=darkblue]End[/color] [color=darkblue]Sub[/color]
[/font]

 

[aeimage]

most image software will return to the original size when you click the zoomed pictures. you just need to add some c# codes in it.

 

[lucywill]

most image software will return to the original size when you click the zoomed pictures. you just need to add some c# codes in it.

yes, you can build a project in Visual Studio and try the above sample codes to reduce and increase image size. hope it work.

 

[gpadnos]

Domenic - I'm using Excel for Mac 2011. I tried this, but I'm getting an error when I click the picture. First, I don't have a "view code" when I right click the sheet tab so I went to Tools/Macro/Visual Basic Editor and pasted your code for "this workbook". I was testing with just your first block of code. The error I get is "Compile error. User defined type not defined." and its highlighting the line in the code "Static Dict As Dictionary". Any ideas how I can fix this?

 

[Domenic]

Domenic - I'm using Excel for Mac 2011. I tried this, but I'm getting an error when I click the picture. First, I don't have a "view code" when I right click the sheet tab so I went to Tools/Macro/Visual Basic Editor and pasted your code for "this workbook". I was testing with just your first block of code. The error I get is "Compile error. User defined type not defined." and its highlighting the line in the code "Static Dict As Dictionary". Any ideas how I can fix this?

That's probably because you'll need to set a reference. Actually, it looks like I neglected to mention it in my original post. So see if this helps...

Open the Visual Basic Editor (Alt+F11), if it's not already opened.
Select Tools
Select References
Select/check Microsoft Scripting Runtime
Select OK
Quit the Visual Basic Editor (Alt+Q)

Does this help

 

[gpadnos]

Thanks, that helped, but I'm still not quite there. Clearly I know nothing about Visual Basic.

I'm trying on a PC with Excel 2003. On my Mac I don't have "Microsoft Scripting Runtime" and it seems its not available on a Mac. So this may just not work on a Mac unless I can find a Mac specific function.

Now I'm getting past the original error point and getting the error "Compile Error: Invalid use of Me keyword". Its stopped on the line "Set Shp = Me.Shapes(Application.Caller)". Any suggestions for this one? I can try Excel 2007 at another computer if that's an issue.

 

[Domenic]

Yeah, I don't use the Mac, so it may not be available. The code should be placed in the sheet module for the sheet containing the picture (right-click the sheet tab, select 'View Code', and paste your code there). Does this help?

 

[gpadnos]

I got on Excel 2007 and I'm having the same error (Invalid use of Me keyword). If I just right click the sheet name, choose View Code, paste your code, and assign the macro, I get an error that says "Cannot run the macro 'Book1!Picture1_Click'. So I go to Macros and create a Macro called "Picture_Click" and paste your code again (The top of this page says "Book1-Module1 (Code)" if that helps), it runs, but I get the error above.

 

[Domenic]

I get an error that says "Cannot run the macro 'Book1!Picture1_Click'.

You'll need to qualify the reference with the code name of the sheet. So, as before, right-click the sheet tab, select 'View Code', and enter the code in the sheet module. Then you'll notice the code name for the sheet at the top of the window. Let's say that it's 'Sheet1'. Now, when you right-click your picture to assign the macro, enter the macro name as...

Sheet1.Picture1_Click