OberonPlace.com Forums

OberonPlace.com Forums (http://forum.oberonplace.com/index.php)
-   CorelDRAW/Corel DESIGNER VBA (http://forum.oberonplace.com/forumdisplay.php?f=16)
-   -   Macro change fountain steps to 999 (http://forum.oberonplace.com/showthread.php?t=7908)

Coby 07-12-2011 09:10

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 07-12-2011 11:40

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.


Coby 07-12-2011 12:00

Worked Perfectly!!! Thanks!

All times are GMT -5. The time now is 03:30.

Powered by vBulletin® Version 3.8.1
Copyright ©2000 - 2020, Jelsoft Enterprises Ltd.
Copyright © 2011, Oberonplace.com