Results 1 to 3 of 3

Macro To Zoom A Picture

This is a discussion on Macro To Zoom A Picture within the Excel Questions forums, part of the Question Forums category; I found this macro that will zoom a picture; the problem is it never returns to the original size. Can ...

  1. #1
    Board Regular
    Join Date
    Dec 2010
    Location
    Ohio Someplace
    Posts
    918

    Default Macro To Zoom A Picture

    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.

    Code:
    Sub Picture_Click()
    Set Shp = ActiveSheet.Shapes(Application.Caller)
    Shp.Select
    ActiveWindow.Zoom = 75
    End Sub

  2. #2
    MrExcel MVP
    Join Date
    Mar 2004
    Location
    Canada
    Posts
    13,632

    Default Re: Macro To Zoom A Picture

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

    Code:
    Option Explicit
    
    Private Sub Picture_Click()
    
        Static Dict As Dictionary
        Static MyPics() As Variant
        Static Cnt As Long
        Static c As Long
        
        Dim Shp As Shape
        
        Cnt = Cnt + 1
        
        If Cnt = 1 Then
            Set Dict = CreateObject("Scripting.Dictionary")
        End If
        
        Set Shp = Me.Shapes(Application.Caller)
        
        If Not Dict.Exists(Shp.Name) Then
            c = c + 1
            Dict.Add Shp.Name, c
            ReDim Preserve MyPics(1 To 2, 1 To c)
            MyPics(1, c) = Shp.Name
            MyPics(2, c) = True
        End If
        
        If MyPics(2, Dict.Item(Shp.Name)) = True Then
            MyPics(2, Dict.Item(Shp.Name)) = False
            Shp.ScaleHeight 1.5, msoTrue 'increase height by 50%
            Shp.ScaleWidth 1.5, msoTrue 'increase width by 50%
        Else
           MyPics(2, Dict.Item(Shp.Name)) = True
            Shp.ScaleHeight 1, msoTrue 'scale to original height
            Shp.ScaleWidth 1, msoTrue 'scale to original width
        End If
    
    End Sub
    
    
    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...

    Code:
    Sub AssignMacro()
        Dim Shp As Shape
        For Each Shp In Sheet1.Shapes 'change the sheet name accordingly
            If Shp.Type = 13 Then 'picture
                Shp.OnAction = "Sheet1.Picture_Click"
            End If
        Next Shp
    End Sub
    
    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:

    Code:
    Sub ResetToOriginalSize()
        Dim Shp As Shape
        For Each Shp In Sheet1.Shapes
            If Shp.Type = 13 Then 'picture
                Shp.ScaleHeight 1, msoTrue 'scale to original height
                Shp.ScaleWidth 1, msoTrue 'scale to original width
            End If
        Next Shp
    End Sub
    
    In the code module for 'ThisWorkbook' (double-click the icon for 'ThisWorkbook' in the Project Explorer window)...

    Code:
    Private Sub Workbook_Open()
        Call ResetToOriginalSize
    End Sub
    
    Domenic
    Microsoft MVP - Excel
    xl-central.com - "For Your Microsoft Excel Solutions"

  3. #3
    New Member
    Join Date
    May 2013
    Posts
    1

    Default Re: Macro To Zoom A Picture

    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.

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  


DMCA.com