Sub Test() Dim s As Shape, sr As New ShapeRange Dim w As Double, h As Double Dim c1 As New Color, c2 As New Color w = ActivePage.SizeWidth / 2 h = ActivePage.SizeHeight / 2 c1.RGBAssign 255, 0, 0 c2.RGBAssign 255, 255, 255 Set s = ActiveLayer.CreateRectangle2(0, 0, w, h) s.Fill.ApplyFountainFill c1, c2, , 45 sr.Add s Set s = ActiveLayer.CreateRectangle2(w, 0, w, h) s.Fill.ApplyFountainFill c1, c2, , 135 sr.Add s Set s = ActiveLayer.CreateRectangle2(0, h, w, h) s.Fill.ApplyFountainFill c1, c2, , -45 sr.Add s Set s = ActiveLayer.CreateRectangle2(w, h, w, h) s.Fill.ApplyFountainFill c1, c2, , -135 sr.Add s sr.OrderToBackEnd Sub