Sub Test() Dim s As Shape, eff As Effect Set s = ActiveLayer.CreateRectangle(0, 0, 5, 5) s.Fill.ApplyFountainFill Set s = ActiveLayer.CreateEllipse(1, 1, 6, 6) Set eff = s.CreateLens(cdrLensCustomColorMap, , CreateRGBColor(255, 0, 0), CreateRGBColor(255, 255, 0)) eff.Lens.ColorMapPalette = cdrRainbowCWFountainFillBlendEnd Sub