Sub Test() Dim s As Shape, sp As Shape Dim pwc As PowerClip For Each s In ActivePage.Shapes Set pwc = Nothing On Error Resume Next Set pwc = s.PowerClip On Error GoTo 0 If Not pwc Is Nothing Then For Each sp In pwc.Shapes If sp.Type = cdrRectangleShape Then sp.Fill.UniformColor.RGBAssign 255, 0, 0 End If Next sp End If Next sEnd Sub