Sub Test() Dim s As Shape, s1 As Shape Set s = ActiveLayer.CreateRectangle(0, 0, 2, 2) s.Fill.UniformColor.RGBAssign 255, 0, 0 s.Transparency.ApplyFountainTransparency , , cdrRadialFountainFill Set s1 = s.Duplicate(2, 0) s1.Transparency.Start = 100 s1.Transparency.End = 0End Sub