Sub Test() Dim s1 As Shape, s2 As Shape Set s1 = ActiveLayer.CreateEllipse2(2, 2, 1) s1.Fill.UniformColor.RGBAssign 255, 0, 0 Set s2 = ActiveLayer.CreateRectangle2(4, 4, 1, 1) s2.Fill.UniformColor.RGBAssign 255, 255, 0 With s2.CreateBlend(s1).Blend .LinkAcceleration = False .ColorAcceleration = 50 .SpacingAcceleration = -50 .AccelerateSize = True End WithEnd Sub