Sub Test() Dim cl As FountainColor If ActiveShape.Fill.Type <> cdrFountainFill Then MsgBox "The selected shape must have a fountain fill." Exit Sub End If For Each cl In ActiveShape.Fill.Fountain.Colors cl.Color.ConvertToGray Next cl ActiveShape.Fill.Fountain.StartColor.ConvertToGray ActiveShape.Fill.Fountain.EndColor.ConvertToGrayEnd Sub