Sub Test() Dim s As Shape, ss As Shape Set s = ActiveShape For Each ss In ActiveLayer.Shapes If ss.OrderIsInFrontOf(s) And Not ss Is s Then ss.Fill.UniformColor.RGBAssign 255, 0, 0 End If Next ssEnd Sub