Color a shape of a group of shapes

[Lucilla]

Ciao!
I need your help! It is two or three days I'm looking for a solution...
Background: I have a sheet with a same picture 3 times. the picture is a grouping of a lot of shapes, it represents the world map, so each shape it is called with the name of the country (e.g. Russia, USA, Italy...).
Now, what I need to do is to color some countries according to a value in a cell.
This code works, but only if I have only one picture!

Sub color()
With ActiveSheet
     With .Shapes("china").Fill.ForeColor
 
     .SchemeColor = 15
     End With
End With
End Sub

I need something to indicate "which"

.Shapes("china")

I want to color, if it is the "china" of group 1, group2 or group 3...


Is there any solution?!?!!?

THANK YOU!!!

 

[Gary McMaster]

It sounds like "GroupItems" is what you are looking for. Sample below.

Hope it helps.

Gary

Public Sub Test()

Dim oShape As Shape

'At least 2 grouped rectangles on activesheet with one named "Rectangle 1"
For Each oShape In ActiveSheet.Shapes
    If oShape.Type = msoGroup Then
        oShape.GroupItems("Rectangle 1").Fill.ForeColor.RGB = RGB(255, 0, 0)
    End If
Next oShape

End Sub

 

[Lucilla]

It is great!!! THANK YOU!
the only problem is how I distinguish the group: "china" has different colour among the groups according to the values of different cells.
Let's say:

• group1 is related to cell1 and china is green if cell1 is 1, red if 0 or yellow if -1
• group2 is related to cell2 and china is green if cell2 is 1, red if 0 or yellow if -1
• group3 is related to cell3 and china is green if cell3 is 1, red if 0 or yellow if -1

in your code, which is the variable that can allow me to take the right color?

 

[Gary McMaster]

I'm not certain I understand the question but the grouped shape also has a name which is usually different from any of the shapes within. When you create the group it is automatically named "Group 1", "Group 2" etc. Of course you can change the names to whatever you want when you create the group. Please try the sample below. You still need 2 the grouped rectangles as stated before.

Public Sub Test()

Dim oShape As Shape

'At least 2 grouped rectangles on activesheet with one named "Rectangle 1"
For Each oShape In ActiveSheet.Shapes
    If oShape.Type = msoGroup Then
    
        Select Case oShape.Name
            Case "Group 1"
                oShape.GroupItems("Rectangle 1").Fill.ForeColor.RGB = RGB(255, 0, 0)
                
            Case "Group 2"
                oShape.GroupItems("Rectangle 1").Fill.ForeColor.RGB = RGB(0, 255, 0)
                
            Case "Group 3"
                oShape.GroupItems("Rectangle 1").Fill.ForeColor.RGB = RGB(0, 0, 255)
                
            Case "China"
                oShape.GroupItems(1).Fill.ForeColor.RGB = RGB(255, 0, 255) ' First item in group
                
            Case Else
                oShape.GroupItems(1).Fill.ForeColor.RGB = RGB(0, 255, 255) ' First item in group
            
        End Select
        
    End If
Next oShape

End Sub

You can also use "Select Case" to select an action based on the contents of a cell:

Select Case Activesheet.Range("A1").Value

Case 1
  'Some code
Case 2
  'Some code
Case Else

End Select

Gary

 

[Lucilla]

YOU ARE A GENIUS!!!!!!
You Save me a lot of time, selecting all the countries and setting the right color!!!

If one day you come in Italy, contact me and you will have coffe' for free!!!

Thank you very much!

 

[Gary McMaster]

You're welcome.

Keep in mind that Select Case is case sensitive. "China" & "cHina" are completely different to Select Case. You can use the "UCase" or "LCase" functions (VBA Help) to convert all the names to upper or lower case for use in the Select Case structure.

Gary

 

[Lucilla]

Ehi Gary,
I hope the last question on this topic:
If the picture Group 1 is composed by both shapes and groups? with your help I am able now to set the color for the shapes, but I got an error when I look for a gorup. this is the case of states with also islands so I have to create a group of shapes
e.g. Canada with a lot of islands, I have in picture Group 1 the group called Canada and a shape called China (a single item)...with

oShape.GroupItems("China").

... I set the color for china, but when it comes to

oShape.GroupItems("Canada").

I have an error.

thank you again for your great contribution!

 

[Gary McMaster]

Having groups inside of groups makes things considerably more complicated especially if they are nested more than 1 level deep. A clear example of how to handle your particular situation will be difficult to provide.

Consider the line:

If oShape.Type = msoGroup Then

This allows you to determine what action to take (grouped or not grouped). You've already discovered that "GroupItems" will fail if you apply it to a shape that is not a group. Once you have determined that a shape is a group, you would then have to check each "GroupItem" to see if any of the members of the parent group are groups themselves. It could get out of control very quickly.

Also have a look at the "ShapeRange" topic in VBA help. Shaperange will allow you to temporarily "ungroup" a group of shapes, make your changes to the shapes within (as individual shapes) and then regroup the shaperange back into a single group. There is some sample code below using ShapeRange and some more in the thread below where we touched on using "Groups" and "Shaperange". There is some example code in VBA help as well.

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

Gary


To try the example below, create 3 rectangles on a new worksheet named "Rectangle 1", "Rectangle 2" & "Rectangle 3". Group "Rectangle 1" & "Rectangle 2". Then create a second group which includes "Rectangle 3" and the first group (nested group).

Public Sub Test()

Dim oShape As Shape
Dim oMyNamedGroup As Shape
Dim oGroupMember As Shape
Dim oShapeRange As ShapeRange

For Each oShape In ActiveSheet.Shapes
    If oShape.Type = msoGroup Then
    
        Set oShapeRange = oShape.Ungroup
        
        For Each oGroupMember In oShapeRange
        
            If oGroupMember.Type = msoGroup Then
                MsgBox oGroupMember.Name & " is a nested shape containing " & oGroupMember.GroupItems.Count & " shapes"
            Else
                MsgBox oGroupMember.Name & " is a group member but is not nested"
            End If
        Next oGroupMember
        
        Set oMyNamedGroup = oShapeRange.Regroup
        oMyNamedGroup.Name = "Canada_Group"
        
    End If
Next oShape

End Sub

 

[Lucilla]

I have never reply , but it works perfectly!!!

Thanks a lot!!!