M
Mogwai
Hi there,
I have quite a few groups with the same number *and name* of Shapes
within, exactly like so:
"Group 1" has "Shape 1", "Shape 2", "Shape 3"
"Group 2" has "Shape 1", "Shape 2", "Shape 3"
I assigned Daves code (below) to each and every Shape. However, if I
click on a Shape in "Group 2" Excel reports that the Shape is part of
"Group 1"
I assume this is due to Shapes in "Group 2" having the same name as
Shapes in "Group 1", but is there any way I can get the correct Group
name for the Shape within?
Thanks
Sub TestSub()
Dim myShape As Shape
Dim i As Long
Dim FoundIt As Boolean
Dim itemCount As Long
FoundIt = False
For Each myShape In ActiveSheet.Shapes
itemCount = 0
On Error Resume Next
itemCount = myShape.GroupItems.Count
On Error GoTo 0
If itemCount > 0 Then
For i = 1 To myShape.GroupItems.Count
If myShape.GroupItems(i).Name = Application.Caller Then
MsgBox myShape.GroupItems(i).Name & vbLf &
myShape.Name
myShape.Select
FoundIt = True
Exit For
End If
Next i
If FoundIt Then
Exit For
End If
Else
If myShape.Name = Application.Caller Then
myShape.Select
Exit For
End If
End If
Next myShape
End Sub
I have quite a few groups with the same number *and name* of Shapes
within, exactly like so:
"Group 1" has "Shape 1", "Shape 2", "Shape 3"
"Group 2" has "Shape 1", "Shape 2", "Shape 3"
I assigned Daves code (below) to each and every Shape. However, if I
click on a Shape in "Group 2" Excel reports that the Shape is part of
"Group 1"
I assume this is due to Shapes in "Group 2" having the same name as
Shapes in "Group 1", but is there any way I can get the correct Group
name for the Shape within?
Thanks
Sub TestSub()
Dim myShape As Shape
Dim i As Long
Dim FoundIt As Boolean
Dim itemCount As Long
FoundIt = False
For Each myShape In ActiveSheet.Shapes
itemCount = 0
On Error Resume Next
itemCount = myShape.GroupItems.Count
On Error GoTo 0
If itemCount > 0 Then
For i = 1 To myShape.GroupItems.Count
If myShape.GroupItems(i).Name = Application.Caller Then
MsgBox myShape.GroupItems(i).Name & vbLf &
myShape.Name
myShape.Select
FoundIt = True
Exit For
End If
Next i
If FoundIt Then
Exit For
End If
Else
If myShape.Name = Application.Caller Then
myShape.Select
Exit For
End If
End If
Next myShape
End Sub