Sub Test() Dim s1 As Shape, s2 As Shape Set s1 = ActiveLayer.CreateRectangle(0, 0, 5, 5) s1.Fill.ApplyFountainFill Set s2 = ActiveLayer.CreateEllipse(1, 1, 6, 6) With s2.CreateLens(cdrLensHeatMap).Lens .PaletteRotation = 50 End WithEnd Sub