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 13-07-2010, 11:32
kunghel kunghel is offline
Junior Member
 
Join Date: Jun 2010
Posts: 27
Default Convert Black RGB to Black CMYK (k100)

I'm trying to set up a macro to convert RGB black to CMYK Black (C0, M0, Y0, K100).

I have serious problems with my client when the text and other details that
he had just been printed with the four colors (hehehe).


Code:
Private Sub Preto_RGB_para_Preto_CMYK(ss As Shapes)
    Dim s As Shape
    
    For Each s In ss
    
    ' I don't know how find and select the RGB Blacks
    Then 'ActiveLayer.Shapes(1).Fill.UniformColor.CMYKAssign 0, 0, 0, 100
    'ActiveLayer.Shapes(2).Outline.SetProperties Color:=CreateCMYKColor(0, 0, 0, 100)
    Next s
End Sub
Someone can help me please?
Reply With Quote
  #2  
Old 13-07-2010, 12:06
shelbym's Avatar
shelbym shelbym is offline
Senior Member
 
Join Date: Nov 2002
Location: Cheyenne, WY
Posts: 1,769
Blog Entries: 9
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 RGB Black to CMYK Black

You didn't say which version of CorelDRAW you where using. The following will work for X4 and X5 as it uses CQL to find the fills and outlines that are RGB Black.

Code:
Private Sub Preto_RGB_para_Preto_CMYK(ss As Shapes)
    Dim srFill As ShapeRange
    Dim srOutline As ShapeRange
    
    Set srFill = ss.FindShapes(Query:="@fill.color = rgb(0,0,0)")
    Set srOutline = ss.FindShapes(Query:="@outline.color = rgb(0,0,0)")
    
    srFill.ApplyUniformFill CreateCMYKColor(0, 0, 0, 100)
    srOutline.SetOutlineProperties Color:=CreateCMYKColor(0, 0, 0, 100)
End Sub
-Shelby
Reply With Quote
  #3  
Old 13-07-2010, 12:22
runflacruiser's Avatar
runflacruiser runflacruiser is offline
Senior Member
 
Join Date: Jun 2009
Location: Pigeon Forge, TN USA
Posts: 811
Default

Ah. You beat me Shelby.
Here's mine:

(Use Shelby's, it will be faster!)

Code:
Sub changeColors()

Dim s As Shape
    For Each s In ActivePage.FindShapes
    On Error Resume Next
        convertShapeCol s
    Next s
End Sub

Private Sub convertShapeCol(s As Shape)
    Dim col1 As New Color, col2 As New Color
    col1.CopyAssign CreateCMYKColor(0, 0, 0, 100)
    col2.CopyAssign CreateRGBColor(0, 0, 0)
    
    'change fill to cmyk black
    If s.Fill.UniformColor.IsSame(col2) Then s.Fill.UniformColor.CopyAssign col1
    'change outline to cmyk black
    If s.Outline.Color.IsSame(col2) Then s.Outline.Color.CopyAssign col1
        
End Sub
John
Reply With Quote
  #4  
Old 13-07-2010, 12:25
kunghel kunghel is offline
Junior Member
 
Join Date: Jun 2010
Posts: 27
Default

Sorry,I'm using the X4.
I'm making a test but, It ask me for another macro.
I think I make some mistake on my code.

This is an aplication to run alone.
Can you correct me Shelby, please?

thanks
Reply With Quote
  #5  
Old 13-07-2010, 12:30
shelbym's Avatar
shelbym shelbym is offline
Senior Member
 
Join Date: Nov 2002
Location: Cheyenne, WY
Posts: 1,769
Blog Entries: 9
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 RGB Black to CMYK Black

This version will work on it own:
Code:
Sub RGBBlackToCMYK()
    Dim srFill As ShapeRange
    Dim srOutline As ShapeRange
    
    Set srFill = ActivePage.Shapes.FindShapes(Query:="@fill.color = rgb(0,0,0)")
    Set srOutline = ActivePage.Shapes.FindShapes(Query:="@outline.color = rgb(0,0,0)")
    
    srFill.ApplyUniformFill CreateCMYKColor(0, 0, 0, 100)
    srOutline.SetOutlineProperties Color:=CreateCMYKColor(0, 0, 0, 100)
End Sub
-Shelby
Reply With Quote
  #6  
Old 13-07-2010, 12:42
shelbym's Avatar
shelbym shelbym is offline
Senior Member
 
Join Date: Nov 2002
Location: Cheyenne, WY
Posts: 1,769
Blog Entries: 9
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 Color.CopyAssign

Hey John,

Instead of using CopyAssign to create your color, you can just do this:
Code:
    col1.CMYKAssign 0, 0, 0, 100
    col2.RGBAssign 0, 0, 0
It is a little shorter, and I know how you love that. :-)

-Shelby
Reply With Quote
  #7  
Old 13-07-2010, 12:48
runflacruiser's Avatar
runflacruiser runflacruiser is offline
Senior Member
 
Join Date: Jun 2009
Location: Pigeon Forge, TN USA
Posts: 811
Default

Cool, Thanks.
I gotta get into the habit of using CQL too!

-John
Reply With Quote
  #8  
Old 13-07-2010, 13:32
kunghel kunghel is offline
Junior Member
 
Join Date: Jun 2010
Posts: 27
Default Maravilha!!!

100% working.

Thanks again guys.

Your are the man!
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
Convert All fills except black to white - how? knowbodynow CorelDRAW/Corel DESIGNER VBA 3 08-06-2011 07:32
Embedded Excel worksheet showing up black Flow_FX General 1 19-07-2007 15:38
Clear then black chanel cmjmmrp General 1 26-04-2007 08:30
Relace all colors but black... ddonnahoe CorelDRAW/Corel DESIGNER VBA 7 22-11-2004 19:09
Color to Black & White Mark CorelDRAW/Corel DESIGNER VBA 3 20-07-2004 15:57


All times are GMT -5. The time now is 13:59.


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