VBA help needed (search and replace colours)
fremoikaner
Hi there!
Please be patient with me - this is the first time I'm using a
newsgroup. And my english is a little bit rusty - I'm from germany.
I have documents with drawings and want to have them transfered to other
layers and partially replace there the colors. This is necesaary for
printing this documents on an alps printer which can print all colours
and white, silver and gold. A usual color seperation is not working
correctly so I need different layers. The layers are named "Glanz" for
the finishing, "Weiss" for white, "bunt" for all colours, "silber" for
silver and "gold" for ... right gold ;-)
I'm trying to write a VBA that does the following things:
All objects are drawn on the layer "Glanz".
1. Copy all objects from layer "Glanz" to layer "Weiss"
2. Disable layer "Glanz"
3. Select all objects on layer "Weiss" (one after the other)
3a. If an object has outline-color "black" - change outline-color to "white"
3b. If an object has fill-color "black" - change fill-color to "white".
4. Disable layer "Weiss"
5. Enable layer "Glanz"
6. Copy all objects from layer "Glanz" to layer "bunt"
6a. Disable layer "Glanz"
7. Select all objects on layer "bunt" (one after the other)
7a. If an object has outline-color "10% black" or "30% black" or "gold"
- change outline-color to "white"
7b. If an object has fill-color "10% black" or "30% black" or "gold" -
change fill-color to "white".
8. Disable layer "bunt"
9. Enable layer "Glanz"
10. Copy all objects from layer "Glanz" to layer "silber"
10a. Disable layer "Glanz"
11. Select all objects on layer "silber" (one after the other)
11a. If an object has outline-color <> "30% black" - change
outline-color to "white" else change outline-color to "black"
11b. If an object has fill-color <> "30% black" - change fill-color to
"white" else change fill-color to "black"
12. Disable layer "silber"
13. Enable layer "Glanz"
14. Copy all objects from layer "Glanz" to layer "gold"
14a. Disable layer "Glanz"
15. Select all objects on layer "gold" (one after the other)
15a. If an object has outline-color <> "gold" - change outline-color to
"white" else change outline-color to "black"
15b. If an object has fill-color <> "gold" - change fill-color to
"white" else change fill-color to "black"
16. Disable layer "gold"
This is what I recorded in CorelScript and than transfered to VBA:
With CreateObject("CorelDraw.Automation.9")
.StartOfRecording
.SuppressPainting True
.SelectLayer "Glanz"
.SelectAllObjects
.RecorderSelectObjectsByIndex True, 1, -1, -1, -1, -1
.CopyToLayer "Bunt"
.UnSelectAll
.SetLayerVisible False, "Bunt", 0
.SelectAllObjects
.RecorderSelectObjectsByIndex True, 1, -1, -1, -1, -1
.CopyToLayer "Weiss"
.ResumePainting
.EndOfRecording
End With
End Sub
This VBA-code I found on www.oberonplace.com:
Sub Fillallwithred()
Dim s As Shape
For Each s In ActiveDocument.ActivePage.Shapes
s.Fill.UniformColor.RGBAssign 255,0,0
Next s
End Sub
This might be a part of the possible solution.
But I'm not able to combine this two parts together.
This is why I'm asking for your help on this sunny sunday :-)
Thanks a lot in advance
and a lot of greetings from germany
fremoikaner
Michael Cervantes
Edit/Find and Replace/Find Object.
Begin New Search
Set object Fills and Outline characteristics you want to find.
In the Find bar, select Find All.
Now you can change color property for all this objects at ones, and move
them to any layer you please.
--
Michael Cervantes
C-Tech Volunteer
fremoikaner
Hi Michael
Michael Cervantes schrieb:
[...]>
> Now you can change color property for all this objects at ones, and move
> them to any layer you please.
Yes, but that's not my problem.
With this "search and replace" I can just replace *one* color.
But my objects have a lot of different colors which needed to be changed
(some to black - some to white).
Thanks for your idea - but this is not a possible solution for me!
Best regards
Andreas
Michael Cervantes
Does this mean that you want to change your color to grayscale?
In this case run the Replace Object wizard and select to change any Color
Mode to Grayscale.
fremoikaner
Hi Michael,
no. The color-changing wizard cannot be recorded and this is not the
problem itself.
Did I describe the problem too complicated?
Example:
I have on a first layer an object with a green outline, an object with a
green filling and an object with a red filling.
Now a VBA-Makro should do:
Copy all object to an new layer "green".
On this layer all objects that have outline-color "green" the
outline-color should be changed to "black". If there's no outline-style
it should keep this. The same now with the fill-color ...
All objects that are not green should be changed (outline or fill-color)
to white.
This is just an example - I hope it's now easier to understand.
Thanks again for your try.
fremoikaner
Michael Cervantes schrieb:
Michael Cervantes
>
> Now a VBA-Makro should do:
> Copy all object to an new layer "green".
> On this layer all objects that have outline-color "green" the
> outline-color should be changed to "black".
Select one of the object with the outline green. Edit/Find and Replace/Find
Object. Select the option to find object with the same characteristic. The
Wizard will select all object with similar color in the outline. Change
outline to Black.
If there's no outline-style
> it should keep this. The same now with the fill-color ...
> All objects that are not green should be changed (outline or fill-color)
> to white.
Select one object filled green. Repeat above operation. Now move them to
different layer. Lock this layer and double click on Pick Tool. All other
objects will be selected. Change outline color to white.
--
Michael Cervantes
C-Tech Volunteer