• Status: Solved
  • Priority: High
  • Security: Public
  • Views: 44
  • Last Modified:

FResize graphics on currently active worksheet using VBA

Dear Experts:

for all the graphics on the currently active worksheet whose name start with "graphic_" should be formatted as follows:

Width and Height: 69%
Lock Aspect Ratio: checked
Relative To Original Picture Size: checked.

Help is much appreciated. Thank you very much in advance.

Regards, Andreas
0
Andreas Hermle
Asked:
Andreas Hermle
  • 5
  • 2
  • 2
2 Solutions
 
Rgonzo1971Commented:
Hi,

pls try
Sub macro()

For Each Shp In ActiveSheet.Shapes
    If Shp.Name Like "graphic_*" Then
        Shp.LockAspectRatio = msoTrue
        Shp.ScaleHeight 0.69, msoTrue, msoScaleFromTopLeft
    End If
Next
End Sub

Open in new window

Regards
0
 
Fabrice LambertFabrice LambertCommented:
Side notes:

- Don't use objects such as ActiveWorkbook, ActiveSheet, Selection, ActiveSheep as these objects are user dependant, are by nature chaotic and unpredictable.
Prefer referencing explicitly the object you want to use.
If you really have no choice but using ActiveSheet, prefix it with ThisWorkbook.
- Option explicit at top of your modules never hurt.

Also, I would add à parameter, for reusability purpose and respect to SRP.
Sub macro(byref ws As Excel.Worksheet)
    Dim Shp As Excel.Shape

    For Each Shp In ws.Shapes
        If Shp.Name Like "graphic_*" Then
            Shp.LockAspectRatio = msoTrue
            Shp.ScaleHeight 0.69, msoTrue, msoScaleFromTopLeft
        End If
    Next
End Sub

Open in new window

0
 
Andreas HermleTeam leaderAuthor Commented:
Hi Rafael,

thank you very much for your swift help. I just noticed I cannot name graphics on the currently active sheet. I know how to do that for charts, but for graphics, I have got no idea.

Alternatively how would your coding change if I run this code on the selected graphics?
0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

 
Andreas HermleTeam leaderAuthor Commented:
Uppps, Rafael I found out myself how to name the graphics (pressing Alt+F10 brings up the dialog box on which to work)

Anyway, how would your code change if I select the graphics and then run the macro?

Hi Fabrice: thank you very much for your help. Will test it and then let you know. I will get back to you tomorrow at the latest.

Thank you very much to both of you. Regards, Andreas
0
 
Rgonzo1971Commented:
if you want to use the selection

then try
Sub macro1()
For Each Shp In Selection
        Shp.ShapeRange.LockAspectRatio = msoTrue
        Shp.ShapeRange.ScaleHeight 0.69, msoTrue, msoScaleFromTopLeft
Next
End Sub

Open in new window

0
 
Andreas HermleTeam leaderAuthor Commented:
Hi Farbrice,

thank you very much for bringing your points to my attention. As a matter of fact, I am aware of all the things you said, especially that one should never use the 'Selection Object'.

Could you please tell me how to run your macro, if I run it a dialog box pops prompting me to select a macro.

Rafael, both codes work just fine. Thank you very much for :-)
0
 
Fabrice LambertFabrice LambertCommented:
Well, first you'll need to write a procedure without parameters so it will be callable as macro.
And within the procedure , call the procedure named macro with the right parameter.
Public Sub myProcedure()
    macro ThisWorkbook.Worksheets(1)
End Sub

Open in new window

0
 
Andreas HermleTeam leaderAuthor Commented:
Ok, Fabrice, thank you very much for your help. It works :-)

I suggest distributing the points 700 to 300 since Rafael was quicker to answer.
0
 
Andreas HermleTeam leaderAuthor Commented:
Thank you very much to both of you. Both codes work just fine. I really appreciate your professional expertise!
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

  • 5
  • 2
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now