View Single Post
  #15  
Old 08-09-2011, 01:30
grzjanik grzjanik is offline
Member
 
Join Date: Mar 2010
Location: Lodz, Poland
Posts: 86
Send a message via Skype™ to grzjanik
Default Yes! Yes! Yes! :)

Hello!
Boys You are great.
The code works in Corel 12 after a small change.
Big thank you for your time and willingness.
The following valid code:

Quote:
Sub GradientToPowerclipAll()
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.SetProperties 0# '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
Best regards.
~GrzJanik
Reply With Quote