View Single Post
Old 05-09-2011, 10:34
runflacruiser's Avatar
runflacruiser runflacruiser is offline
Senior Member
Join Date: Jun 2009
Location: Pigeon Forge, TN USA
Posts: 811

I think this mod would do but I didn't test.

Sub GradientToPowerclip()
    Const dblEnlarge = 1
    Dim s As Shape, sDup As Shape
    Dim sr As ShapeRange
    ActiveDocument.ReferencePoint = cdrCenter 'Set reference point to the center
    ActiveDocument.Unit = cdrMillimeter 'Set our unit to millimeters
    Set sr = ActivePage.Shapes.FindShapes()
    For Each s In sr.Shapes 'Loop thtough all the shapes found
        If s.Fill.Type = cdrFountainFill Then
            Set sDup = s.Duplicate 'Make a duplicate
            sDup.SetSize s.SizeWidth + dblEnlarge, s.SizeHeight + dblEnlarge 'Increase the size by our Constant
            sDup.Fill.Fountain.Steps = 999 'Set fountain fill steps to 999
            sDup.Outline.SetNoOutline 'Remove outline from duplice
            Set sDup = sDup.ConvertToBitmapEx(cdrCMYKColorImage, False, False, 300, cdrNormalAntiAliasing, True) 'Convert to Bitmap
            s.Fill.ApplyNoFill 'Remove fill from original shape
            sDup.AddToPowerClip s 'Place the bitmap in the orginal shape
        End If
    Next s
End Sub
Reply With Quote