Sub Test() Dim s As Shape Set s = ActiveLayer.CreateRectangle(2, 4, 6, 8) s.Fill.ApplyFountainFill CreateRGBColor(255, 0, 0), CreateRGBColor(0, 255, 0), cdrConicalFountainFill, , 256 With ActiveDocument .PrintSettings.PostScript.OptimizeFountainFills = True .PrintOut End WithEnd Sub