OberonPlace.com Forums  

Go Back   OberonPlace.com Forums > Developer Forums > VBA > CorelDRAW/Corel DESIGNER VBA

Reply
 
Thread Tools Search this Thread Display Modes
  #1  
Old 29-12-2007, 02:08
admold
Guest
 
Posts: n/a
Default Replace color

Hello, I'm wondering if anyone knew to create a script to replace a color with other color (a Pantone color with a CMYK color). For example: Pantone 032 U 100% with Magenta 100%; Pantone 032 U 99% with Magenta 99%.... Pantone 032 U 1% with Magenta 1%.

I write this for replace Blue with Cyan, but I don't know how to replace Pantone color!

Sub repl_color()
Dim s As Shape
For Each s In ActiveDocument.ActivePage.Shapes

If s.Fill.UniformColor.IsSame(CreateCMYKColor(100,100, 0, 0)) Then
s.Fill.UniformColor.CMYKAssign 100, 0, 0, 0
End If
Next s
End Sub

Last edited by admold; 29-12-2007 at 03:44.
Reply With Quote
  #2  
Old 29-12-2007, 13:37
shelbym's Avatar
shelbym shelbym is online now
Senior Member
 
Join Date: Nov 2002
Location: Cheyenne, WY
Posts: 1,782
Blog Entries: 11
Send a message via ICQ to shelbym Send a message via AIM to shelbym Send a message via MSN to shelbym Send a message via Yahoo to shelbym
Default ConvertToCMYK

First I am no expert when it comes to Pantone Colors, but I think you are asking just to convert the Pantone Color to CMYK. That is pretty easy. Try something like this:
Code:
Sub ConvertToCMYK()
    Dim s As Shape
    
    For Each s In ActiveDocument.ActivePage.Shapes
        If s.Fill.Type = cdrUniformFill Then s.Fill.UniformColor.ConvertToCMYK
    Next s
End Sub
Hope that helps,

-Shelby
Reply With Quote
  #3  
Old 29-12-2007, 15:22
wOxxOm's Avatar
wOxxOm wOxxOm is offline
Senior Member
 
Join Date: Mar 2005
Posts: 836
Default

Code:
Sub repl_color()
   Dim s As Shape, clr As Color, SR As ShapeRange
   Dim pal As Palette, bClosePal As Boolean
   
   Set clr = CreateCMYKColor(100, 100, 0, 0)
   Set SR = New ShapeRange
   
   'collect shapes in SR
   For Each s In ActivePage.FindShapes
      If s.Fill.UniformColor.IsSame(clr) Then SR.Add s
   Next s
   
   'check if Pantone palette is opened in Application
   For Each pal In Palettes
      If pal.PaletteID = cdrPANTONECoated Then Exit For
   Next
   'open Pantone palette
   If pal Is Nothing Then bClosePal = True: Set pal = Palettes.OpenFixed(cdrPANTONECoated)
   
   'apply new fill
   SR.ApplyUniformFill pal.Colors(pal.FindColor("PANTONE 112 C"))
   
   If bClosePal Then pal.Close
End Sub
Reply With Quote
  #4  
Old 31-12-2007, 10:52
admold
Guest
 
Posts: n/a
Default Change

I receive from ALEX a script. I'm change it very little and I get this:

Sub repl_color2()
'

Dim s As Shape, colorSource As Color, SR As ShapeRange
Dim I As Integer

For I = 0 To 100
Set colorSource = CreateFixedColor(cdrPANTONEUncoated, 10, I)
Set SR = New ShapeRange

For Each s In ActivePage.FindShapes
If s.Fill.UniformColor.IsSame(colorSource) Then SR.Add s
Next s

SR.ApplyUniformFill CreateCMYKColor(I, 0, 0, 0)
Next

End Sub
Reply With Quote
  #5  
Old 18-08-2008, 18:04
jess916
Guest
 
Posts: n/a
Default PatternFill

Is it possible to use the .IsSame(clr) for Patterns?
I have the following code.
Code:
With ActiveSelection.Fill.ApplyPatternFill(cdrTwoColorPattern, "%%8A'{#18b]81]bjY,%]%u#97eueA3#B1+8F,A484}84I,B1+N#D4", 0, CreateCMYKColor(0, 0, 0, 0), CreateCMYKColor(100, 0, 100, 0), False)
and I would like to check to see what shapes match this pattern. For example I would like the following code to work.
Code:
Sub test()
Dim s As Shape
Dim sr As ShapeRange
Dim pat As PatternFill
pat = (cdrTwoColorPattern, "%%8A'{#18b]81]bjY,%]%u#97eueA3#B1+8F,A484}84I,B1+N#D4", 0, CreateCMYKColor(0, 0, 0, 0), CreateCMYKColor(100, 0, 100, 0), False)
For Each s In sr
If s.Fill.Pattern.IsSame(pat) Then s.Name = "VDD"
Next s
End Sub
Reply With Quote
Reply


Currently Active Users Viewing This Thread: 1 (0 members and 1 guests)
 
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off

Forum Jump

Similar Threads
Thread Thread Starter Forum Replies Last Post
CorelDRAW X3 VBA Code - Shape & Color LIster JudyHNM Code Critique 2 05-04-2007 14:02
Corel Draw 12 and Color Management... meandirtyjoe General 7 31-12-2005 16:57
replace objects of certain color jwknight CorelDRAW/Corel DESIGNER VBA 3 14-08-2003 12:43
color replacer - some ideas Zuk Macros/Add-ons 0 29-04-2003 03:09


All times are GMT -5. The time now is 12:22.


Powered by vBulletin® Version 3.8.1
Copyright ©2000 - 2021, Jelsoft Enterprises Ltd.
Copyright © 2011, Oberonplace.com