[runflacruiser]

Hi.
That's what I get for not testing.
Sorry, I'm unable to spend more time on this at the moment.
Try this new mod of Shelby's code:

~John

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 '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