Hi guys, I've been trying to make one CorelDraw VBA macro to solve aissue that we have in our workflow. I need to find all shapes that contain one of a list of colors and change the color accordingly so that our printer prints it out correctly. Pretty straightforward stuff, but the problem is, I don't how Corel's macros work. I wrote a code and it sorta works, but when I open another file or another instance it starts throwing error 91. If I cut and paste it back it works. Very strange behaviour.
Here's the code:
Sub FixBlue()
Dim srFill As ShapeRange
Dim srOutline As ShapeRange
Dim srFountain As ShapeRange
Dim colFF As Color
Dim ffs As FountainFill
Dim ffe As FountainFill
Dim s As Shape
Dim f As FountainColor
Dim iVal&
Dim c As Color
Set srFill = FindAllShapes.Shapes.FindShapes(Query:="@fill.color.cmyk[.c=100 and .m=82 and .y=0 and .k=0]")
Set srOutline = FindAllShapes.Shapes.FindShapes(Query:="@outline.color.cmyk[.c=100 and .m=82 and .y=0 and .k=0]")
Set srFountain = FindAllShapes.Shapes.FindShapes(Query:="@fill.type = 'fountain'")
srFill.ApplyUniformFill CreateCMYKColor(0, 0, 100, 0)
srOutline.SetOutlineProperties Color:=CreateCMYKColor(0, 0, 100, 0)
For Each s In srFountain
c.CMYKAssign 100, 82, 0, 0
For Each f In s.Fill.Fountain.Colors
If f.Color.IsSame(c) Then
f.Color.CMYKAssign 0, 0, 100, 0
End If
Next f
Next s
End Sub
Function FindAllShapes() As ShapeRange
Dim s As Shape
Dim srPowerClipped As New ShapeRange
Dim sr As ShapeRange, srAll As New ShapeRange
If ActiveSelection.Shapes.Count > 0 Then
Set sr = ActiveSelection.Shapes.FindShapes()
Else
Set sr = ActivePage.Shapes.FindShapes()
End If
Do
For Each s In sr.Shapes.FindShapes(Query:="[email protected]")
srPowerClipped.AddRange s.PowerClip.Shapes.FindShapes()
Next s
srAll.AddRange sr
sr.RemoveAll
sr.AddRange srPowerClipped
srPowerClipped.RemoveAll
Loop Until sr.Count = 0
Set FindAllShapes = srAll
End Function