Macro change fountain steps to 999

I am trying to record a Macro that will change the fountain steps in a selected object without changing the color properties. My goal is to be able to select the object and change the steps to 999 without changing the colors. My recorded macro changes the colors to match the one I recoreded it with.

This is what I have:

Sub Fountain_Steps()
' Recorded 12/6/2011
Dim OrigSelection As ShapeRange
Set OrigSelection = ActiveSelectionRange
OrigSelection.ApplyFountainSteps CreateRGBColor(), CreateCMYKColor(0, 0, 0, 0), cdrLinearFountainFill, 267.638815, 999, 8, 50, cdrDirectFountainFillBlend
End Sub


thanks for your help!

[shelbym]

I would do something like this:

Sub ChangeFountainSteps()
    Dim s As Shape
    Dim sr As ShapeRange
    
    Set sr = ActiveSelectionRange.Shapes.FindShapes()
    
    For Each s In sr.Shapes
        If s.Fill.Type = cdrFountainFill Then s.Fill.Fountain.Steps = 999
    Next s
End Sub

This code will work with multiple selected shapes, and will also digg into any groups. Hope it helps.

-Shelby

Worked Perfectly!!! Thanks!