Sub Test() Dim s1 As Shape, s2 As Shape, s3 As Shape, s4 As Shape Dim Blend As EffectBlend Set s1 = ActiveLayer.CreateEllipse2(0.6, 4.5, 1) Set s2 = s1.Duplicate(7.4, 4) s1.Fill.UniformColor.RGBAssign 255, 0, 0 s2.Fill.UniformColor.RGBAssign 255, 255, 0 Set Blend = s1.CreateBlend(s2, 30, cdrRainbowCWFountainFillBlend).Blend Set s3 = ActiveLayer.CreateEllipse2(0, 10, 1) Set s4 = s3.Duplicate(5, -3) s3.Fill.UniformColor.RGBAssign 0, 128, 0 s4.Fill.UniformColor.RGBAssign 0, 0, 255 s3.CreateBlend(s4).Blend.CopyFrom BlendEnd Sub