Changing the attributes of just one shape in a group

[NewOrderFac33]

Good afternoon,

I have two grouped objects, a round cornered rectangle and a star, both of which have a fill colour and a border colour.

I want, via VBA obviously to be able to alter the colour of the fill and the border of the rectangle, without altering the fill and the border of the star.

I can't refer to the rectangle and the star by their individual object names, as there are multiple occurrences of grouped rectangles/stars on which I want to perform the operation, having selected the group previously.

Here's what I currently have, but when I run it, it changes the colours of both rectangle and star - I need to be able to just change the rectangle.

Can any of you good folks help?

As always, thanks in advance.
Pete

Sub InProgress_High()

    Dim ActiveShape As Shape
    Dim UserSelection As Variant
    Set UserSelection = ActiveWindow.Selection

    On Error GoTo NoShapeSelected
    Set ActiveShape = ActiveSheet.Shapes(UserSelection.Name)
    'On Error Resume Next
    
    'Pastel Red fill
    With Selection.ShapeRange.Fill
        .Visible = msoTrue
        .ForeColor.ObjectThemeColor = msoThemeColorAccent2
        .ForeColor.TintAndShade = 0
        .ForeColor.Brightness = 0.400000006
        .Transparency = 0
        .Solid
    End With

    'Black text
    With Selection.ShapeRange.TextFrame2.TextRange.Font.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(0, 0, 0)
        .Solid
    End With
    
    'Bright Red Border
    With Selection.ShapeRange.Line
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
        .Weight = 3
    End With
    
    Exit Sub

NoShapeSelected:
    MsgBox "You do not have a shape selected!"

End Sub

 

[NewOrderFac33]

Oh, and one other thing, not all selected objects will have a star - some are just a rectangle, which obviously won't be grouped.

So, what I'm looking for is:

If the selection has more than two objects, cycle through them until you hit the rectangle and make the changes to that.

Cheers

Pete

 

[NewOrderFac33]

OK, it was late and I was being lazy!

Sub AA_ObjectCycle()
    Dim MyCount As Long
    Dim MyShape As Shape
    Dim UserSelection As Variant
    
    Set UserSelection = ActiveWindow.Selection
    Set MyShape = ActiveSheet.Shapes(UserSelection.Name)


    For MyCount = 1 To MyShape.GroupItems.Count
        MsgBox (MyShape.GroupItems(MyCount).Name)
        If InStr(MyShape.GroupItems(MyCount).Name, "Rectangle") > 0 Then
            MsgBox ("Rectangle!")
            'do stuff
        Else
            MsgBox ("Star!")
            'do stuff
        End If
    Next
End Sub