Sub Test() Dim s1 As Shape, s2 As Shape Dim e As Effect, sr As ShapeRange Dim s As Shape Set s1 = ActiveLayer.CreateEllipse(0, 10, 2, 8) Set s2 = s1.Duplicate(5, -7) s1.Fill.UniformColor.CMYKAssign 0, 0, 100, 0 s2.Fill.UniformColor.CMYKAssign 0, 100, 100, 0 Set e = s2.CreateBlend(s1) Set sr = e.Separate For Each s In sr(1).Shapes s.Move Rnd() - 0.5, Rnd() - 0.5 Next sEnd Sub