Sub Test() Dim s As Shape Set s = ActiveLayer.CreateRectangle(0, 0, 3, 3) s.Fill.ApplyUniformFill CreateRGBColor(155, 0, 155) s.OverprintOutline = TrueEnd Sub