Sub Test() Dim c As New Color Dim s As Shape For Each s In ActiveSelection.Shapes If s.Fill.Type = cdrUniformFill Then c.CopyAssign s.Fill.UniformColor c.ConvertToRGB If c.RGBRed > 150 And c.RGBGreen < 100 And c.RGBBlue < 100 Then s.Fill.UniformColor.RGBAssign 0, 0, 0 End If End If Next sEnd Sub