Sub Test() Dim sr As ShapeRange Set sr = ActivePage.FindShapes(Type:=cdrTextShape) sr.ApplyFountainFill CreateRGBColor(255, 0, 0), CreateRGBColor(255, 255, 0), cdrConicalFountainFill, 45End Sub