Grouped Shapes VBA

[IGWright]

Hello Everyone!

I've searched high and low for an answer on this, and still can't quite make it work.

I have a Workbook with many Grouped shapes. One of the problems I've been having is that when I change the focus of the Worksheet, the size of the Shapes change by increments. This seems to be some kind of flaw with the program.

It's not a big deal since the changes are small, but I've been looking into a code based solution. What I've got so far is:

Sub Shapes()
If Shape.Name = "Top" Then
.LockAspectRatio = msoFalse
.Height = 13
.Width = 13
.LockAspectRatio = msoTrue
End If
End Sub

In this case there are several Shapes named "Top". They are all Grouped. The Height and Width are supposed to be 0.18" and I find that if I set the .Height and .Width to 13, it sets those parameters to 0.18".

I can get this code to work for one Shape, but not multiple.

Any help here would be appreciated.

Thank-you,


Ian

 

[BrianB]

I suggest you record a macro.

Once shapes are grouped we cannot change them individually.

You may just need to change the size of the Group.
(select the group and look at name box top left of sheet)

 

[IGWright]

Thank-you for getting back!
This I've discovered through trial and error.
Any tier of Grouped Shapes CAN be accessed through VBA (2007).

If the Work Sheet contains 2 or more Groups or Shapes with the same name, the code below will access the Group or shape at the bottom on the Selection and Visibility pane only (in this case "Outside Diameter").

Sub Shapes()
ActiveSheet.Shapes("Outside Diameter").LockAspectRatio = msoFalse
ActiveSheet.Shapes("Outside Diameter").Height = 40
ActiveSheet.Shapes("Outside Diameter").Width = 40
ActiveSheet.Shapes("Outside Diameter").LockAspectRatio = msoTrue
End Sub

So at this point I'm looking for a way to get the Code to move through all the Groups or Shapes that match it's criteria.


Ian

 

[BrianB]

The usual way is to give the shape or group a unique name and access it that way. (set the shape Name property)

I don't know if my code here will help

http://www.mrexcel.com/forum/showthread.php?t=271794

 

[IGWright]

That occurred to me - that I should give each Shape a unique name.

I am having the same problem as crackjack in that when I record Macros, there's nothing Recorded.

Ian

 

[IGWright]

2010 does record Drawing Tools based Macros, so that's helpful.


Ian

 

[BrianB]

I can get this code to work for one Shape, but not multiple.

Not have time to do code. If you set a variable to include all shapes in a ShapeRange (search on this) you can change the whole lot in one go.

 

[IGWright]

Thank-you Brian.
I'm also thinking the AutoShapes may be more solid with 2010, in that they don't change size on their own (which was the case with 2007).


Ian

 

[BrianB]

may be more solid with 2010,

Works fine in XL2000

 

[ZVI]

Hi Ian,

1) I would suggest to install all service packs for Excel 2007.

2) All shapes even items of the grouped one are accessible via VBA:

Sub Test()
  Dim Shp1 As Shape, Shp2 As Shape
  On Error Resume Next
  For Each Shp1 In ActiveSheet.Shapes
    Debug.Print Shp1.Name, Shp1.Width, Shp1.Height
    For Each Shp2 In Shp1.GroupItems
      Debug.Print vbTab & Shp2.Name, Shp2.Width, Shp2.Height
'      If Shp2.Name = "MyShapeName" Then
'        Shp2.Width = 36
'        Shp2.Height = 258
'      End If
    Next
  Next
End Sub

Regards,
Vladimir