VBA Code for changing line color

[Shaddy Dedmore]

Here's some VBA code that I came up with to change line colors of objects.

Every time I try to save it as a lesser cdr (like ver 11) I lose the VBA... so i thought I'd just post the code.

Let me know if you can't see it and we'll try something else.

Usage: If you have a number of objects with multiple
line colors, let's say red, black and green. And they're
all mixed together, even overlapped. Now you want to
change all the red ones to yellow. Could be a lot of
clicking. Run this using the following steps to change
all the red to yellow...

it's multi-stepped, here's the instructions...

Easiest way I could find to add code manually, is to:
Step 1 - open the VBA editor (alt-F11 in ver 12)
Step 2 - Click on INSERT == MODULE within VB
Step 3 - Paste in the code below

Then to run the macro...

Step 1 - Well, run the VBA code, it's called Macro1 in this case.
TOOLS == VISUAL BASIC == PLAY
Choose Macro1 (unless you renamed it)
Step 2 - Select one Red object by clicking on it
Step 3 - Choose new color (yellow in my example) from popup
Step 4 - Click and drag a Rectangle that will include all of the
red objects that you want to change to yellow.
If you need to scoll, run it multiple times, it's a one shot thing

Hopefully this works so you can cut and paste without having problems with word wrapping.



Sub Macro1()

Dim c As New Color
Dim c2 As Color
Dim d As Document
Dim sel As Shape, s As Shape
Dim sel2 As Shape
Dim b As Boolean
Dim x1 As Double, y1 As Double, x2 As Double, y2 As Double, Shift As Long

Set d = ActiveDocument

b = True

While b = True
MsgBox "Select 1 object that has the color that you want to replace." & vbCrLf & vbCrLf & "The step after that is to pick the new color"

NothingSelected:
d.GetUserClick x1, y1, Shift, 100, True, cdrCursorPick
Set sel = d.ActivePage.SelectShapesAtPoint(x1, y1, False)
If sel.Shapes.Count = 0 Then
MsgBox "No object selected, please select again"

GoTo NothingSelected
End If

Set c2 = sel.Outline.Color

c.UserAssign

MsgBox "Click and Drag bounding rectangle to select objects that you want to change color"

NothingSelected2:

d.GetUserArea x1, y1, x2, y2, Shift, 100, False, cdrCursorWinCross

Set sel2 = d.ActivePage.SelectShapesFromRectangle(x1, y1, x2, y2, False)
If sel2.Shapes.Count = 0 Then
MsgBox "No object selected, please select again"
GoTo NothingSelected2
End If

For Each s In sel2.Shapes
If s.Outline.Color.IsSame(c2) Then
s.Outline.Color = c
End If
Next s
b = False
Wend
End Sub

[Lee DeRaud]

For version 12, the easiest way to distribute/install one of these things is with a '.gms' file. The VBA editor saves your project in C:\Program Files\Corel\Corel Graphics 12\Draw\GMS as 'project_name.gms'. The end user can just copy that file to the corresponding directory on their machine and restart CorelDraw.
(GMS isn't a valid attachment type, so you'll have to embed it in a ZIP file to attach it to a post.)

[Aaron Koehl]

Cool, I'm always up for sharing code. I would recommend using the CODE tags when posting though, and copy and paste into Notepad to remove any extra formatting that might be picked up.

[Shaddy Dedmore]

I'll be darned. I didn't know that's what the CODE tag was for.


Here's a test so i can see what it looks like (c: I think I'll make it kind of long so i can see if it word wraps or not, sorry to waste your space on an experiment though

Just checking. Thanks for your help Aaron and Lee.

SHaddy

[Shaddy Dedmore]

Might not be all that useful for you in its present form. But it's some code for changing all the text on a page to Artistic text. It also changes the font and size.

I'm posting this to show you it's fairly easy to itterate through all the shapes on the page to find certain things, then do stuff to them. You could look for rectangles and ellipses too. You could then even put another If statement in to also choose, like, color. So it'd only change the red text, for example.

The reason I needed this, was because I made those text rectangles for everything on a page. But then i needed to make the text larger, and most of them dissappeared because the box was too small. Instead of making alllll the boxes bigger, I did this. WAY easier. I looked in the help and adapted some code to fit my need, I didn't invent the whole thing.



Sub Macro1()
Dim s As Shape
For Each s In ActivePage.FindShapes(, cdrTextShape)
'look up cdrShapeType in the Help for all shape options
If s.Text.Type = cdrParagraphText Then
s.Text.ConvertToArtistic
s.Text.Story.Size = 14
s.Text.Story.Font = "Arial Black"
End If
Next s
End Sub



Let me know if you need some help coming up with your own.

Shaddy

[Rodne Gold]

Hiya , heres an alternative , you can use the find and replace function in Corel.
All you do is select the atributes in the find and replace function of what you want to find and then say find all , the whole lot of what you want is found and you can easily change it , even within groups.
The filters are VERY powerful , you can for instance find all closed objects with a red outline less then 0.2mm thick and that are filled with cyan.
I know its not VBA or programming , but it's a very powerful function for obtaininbg selection sets.

[Shaddy Dedmore]

I use that function within MSWord all the time. It never even occured to me to look there in corel for objects since I associated that feature with text. I'm sure I'll be testing out that feature quite a bit. Thanks for the tip.

That's why I like these threads, sometimes you don't know enough to ask the questions. But reading tips and examples leads to all sorts of new stuff.

(that's a hint for others to pitch in with anything, you might think everyone does it that way, but odds are we don't)

Shaddy

[Chuck Burke]

Rodney,
I hae used find and replace for text, but the other day I wanted to use it for an "object" ( read that graphic behind some text ). I could not for the life of me figure it out. How the heck do YOU do it?

Thanks
Chuck Burke
American Pacific Awards
Maui Hawaii.

[Rodne Gold]

Click "edit" , click "find and replace" , click "find objects" , click "begin a new search" , then a whole dialog mini screen comes
Lets say you wanted to find all objects with a red outline. What you do is go to the outline tab ,check the box "outline properties" , you will see the "next" option come up , click it , you will then see a whole screen come up with various outline properties , check the colour box , pick the colour you want (red) click the "next" button , click the "finish" button and it will select the last red outlined object , if you click the "find all" it will find all red oulined entities and select them and you can then use the Corel object properties to change them as you wish.