Changing the attributes of just one shape in a group

NewOrderFac33

Well-known Member
Joined
Sep 26, 2011
Messages
1,268
Office Version
  1. 2016
  2. 2010
Platform
  1. Windows
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
Code:
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
 
Last edited:

Excel Facts

Create a chart in one keystroke
Select the data and press Alt+F1 to insert a default chart. You can change the default chart to any chart type

NewOrderFac33

Well-known Member
Joined
Sep 26, 2011
Messages
1,268
Office Version
  1. 2016
  2. 2010
Platform
  1. Windows
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
 
Last edited:

NewOrderFac33

Well-known Member
Joined
Sep 26, 2011
Messages
1,268
Office Version
  1. 2016
  2. 2010
Platform
  1. Windows
OK, it was late and I was being lazy!
Code:
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
 
Last edited:
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,164,625
Messages
5,838,427
Members
430,546
Latest member
CometOz

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top