CODEWITHSUNDEEP
excelvba
Calvin Baker
Calvin Baker

Reputation: 1

Can you group shapes as they are created in Excel?

I have a userform in Excel 2016 that will generate a certain group of shapes (a welding symbol, if the context is helpful), mainly consisting of lines, arcs, and textboxes. Some of these will be the same every time the code is run, while others are options to be determined by the user via the userform. At the end those elements are grouped into a single symbol. My current code works as described thus far.

The problem comes when I try to run the form a second time (generating a second group of shapes independent of the first group). I have it set up such that as the code is executed, it creates a shape, names that shape appropriately, then groups all shapes at the end, referring to them by name. The second time the code is run, it uses the same names as in the first run. As soon as it tries to form the second group, I get an error due to names referring to two different shapes.

My question is this: Is there a way to add shapes to a group (or to a collection to be grouped later) as they are created? It seems naming shapes isn't the way to go, as the names are retained after the code ends. I tried referencing by shape index, but since I have images on the page as well, it's hard to determine exactly what a particular shape's index is. I apologize for the lack of code, as I don't have access to it right now. If needed I can write up something simple to get the point across. Any help is greatly appreciated!

Upvotes: 0

Views: 561

Answers (2)

Calvin Baker
Calvin Baker

Reputation: 1

After some trial and error, the solution I came up with is something like the following.

'Count shapes already on sheet
Shapesbefore=ActiveSheet.Shapes.Count

'Create new shapes

'Create array containing indexes of recently created shapes
Dim shparr() As Variant
Dim shprng  As ShapeRange
ReDim shparr(Shapestart + 1 To ActiveSheet.Shapes.Count)
For i = LBound(shparr) To UBound(shparr)
    shparr(i) = i
Next i


'Group shapes and format weight/color
Set shprng = ActiveSheet.Shapes.Range(shparr)

With shprng
    .Group
    .Line.Weight = 2
    .Line.ForeColor.RGB = 0
End With

This way I don't have to worry about creating and managing various group and shape names, as I don't need to go back and reference them later.

Upvotes: 0

FunThomas
FunThomas

Reputation: 29146

You can group shapes with a command like this:

Dim ws as Worksheet
Set ws = ActiveSheet   ' <-- Set to the worksheet you are working on
ws.Shapes.Range(Array("Heart 1", "Sun 2", "Star 3")).Group

(you can access the shapes via name or via index). The result of the group command is another shape that is added to the sheet. But be aware that the grouped shapes still exists in the sheet, you can access them with the GroupItems-property.

With ws.Shapes
    Dim shGroup As Shape, sh As Shape
    Set shGroup = .Range(Array("Heart 1", "Sun 2", "Star 3")).Group
    shGroup.Name = "MyNewGroup" & .Count
    For Each sh In shGroup.GroupItems
        Debug.Print sh.Name, sh.Type
    Next sh
End With

As you can see, the single shape elements don't change their names, so grouping would not solve your naming issue. The only way is to add a suffix to the name, e.g. a number (as Excel does it when it creates a shape).

Update: Of course the Array- parameter does not need to be static. You can declare an array that is large enough (it doesn't matter if it contains some empty elements).

Const maxShapes = 12
Dim myShapes(1 to maxShapes) as String

myShapes(1) = *Name of first shape you created*
myShapes(2) = *Name of second shape you created*
...
ws.Shapes.Range(myShapes).Group

or use the Redim command:

Dim myShapes() as String

Redim myShapes(1 to NumberOfShapesInYourNewGroup)
myShapes(1) = *Name of first shape you created*
myShapes(2) = *Name of second shape you created*
...
ws.Shapes.Range(myShapes).Group

To get a unique shape and group name, you can implement various methods. I don't like the attempt with a global variable as they might get reset - for example when you cancel execution during debugging. You could use for example the suffix that Excel generates when you create a new shape. Or put the rename-statement into a loop, put a On error Resume Next before the rename (and don't forget to put an On error Goto 0 after it) and loop until renaming was successfull. Or loop over all shapes in your sheet to find the next free name.

Upvotes: 0

Related Questions