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