Sub Test() Dim s As Shape Set s = ActiveSelection.Shapes(1) If s.Fill.Type = cdrUniformFill Then If s.Fill.UniformColor.Type <> cdrColorGray Then s.Fill.UniformColor.GrayAssign 255 s.Fill.UniformColor.Gray = s.Fill.UniformColor.Gray / 2 End If End IfEnd Sub