restore a resized worksheet Picture to original size with vba

xltrader100

New Member
Joined
Dec 8, 2009
Messages
17
I've inserted some Pictures onto a worksheet and need to periodically resize them. After resizing, I'd like to later restore the Pictures to their original size. There's a button (Format Picture/Size/Original Size/Reset) that does this, but when I use the Recorder to try to duplicate this function, the code produced uses the saved height and width numbers from when the Picture was originally inserted.

I don't want to have to keep track of these numbers (especially since Excel already does this by itself automatically) and would like to have the functionality of that Reset button in code. Can I do this?
 

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"
This should reset the pic back to the default size. Edit name(s) as required.
Rich (BB code):
Sub PicReset()
 
    ActiveSheet.Shapes("Picture 1").ScaleHeight 1#, msoScaleFromTopLeft
    ActiveSheet.Shapes("Picture 1").ScaleWidth 1#, msoScaleFromTopLeft
 
End Sub
 
Upvote 0
Thanks, Craig. That looks like it should work, but...

Here's what I've got. It runs ok and picks out all the right Pictures to work on but it doesn't change the Picture size.

Code:
Sub resetPictureSize()
  Dim mapsheet As Worksheet
  Set mapsheet = Sheets("MOSmap")
  Dim shp As Shape
  For Each shp In mapsheet.Shapes
    With shp
      If .Name Like "*Picture*" Then
    '       .Select
        .ScaleHeight 1#, msoScaleFromTopLeft
        .ScaleWidth 1#, msoScaleFromTopLeft
      End If
    End With
  Next shp
 
Upvote 0
Ok, found it. I forgot to make the scaling relative to original size. This works.

Code:
Sub resetPictureSize()
  Dim mapsheet As Worksheet
  Set mapsheet = Sheets("MOSmap")
  Dim shp As Shape
  For Each shp In mapsheet.Shapes
    With shp
      If .Name Like "*Picture*" Then
        .ScaleHeight 1#, True, msoScaleFromTopLeft
        .ScaleWidth 1#, True, msoScaleFromTopLeft
      End If
    End With
  Next shp
End Sub
Thanks again.
 
Upvote 0
Rich (BB code):
Sub PicReset()
    ActiveSheet.Shapes("Picture 1").ScaleHeight 1#, msoScaleFromTopLeft
    ActiveSheet.Shapes("Picture 1").ScaleWidth 1#, msoScaleFromTopLeft
End Sub

Handy piece of code. Thanks!

B...ut why force the "1" to Double ("#") when a Single ("!") is expected?

It seems to me that since type conversion isn't necessary (or commonplace) with static method parameters to begin with, then using "#" does nothing except add four extra calculations to the procedure...?
 
Last edited:
Upvote 0

Forum statistics

Threads
1,213,497
Messages
6,114,002
Members
448,543
Latest member
MartinLarkin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top