In VBA, is there a way to copy a CMYK color value from an object to a Dim and convert that value to RGB without effecting the original object's color?
I'm making a macro that copies text from CorelDraw into a Word document and retains as much formatting as possible (font, size, alignment, etc). In order to copy the colors in the text over to Word they first have to be converted from CMYK to RGB. When I use: s.Text.Story.Range.Fill.UniformColor.ConvertToRGB on my text object the individual letter colors are lost and it all becomes the same color (i.e. if the first letter is green and a couple words are yellow, after ConvertToRGB all the text becomes green).
Within the macro (it's too long and complicated to post in this box) there is a loop that goes through each letter in each textbox, getting (from CorelDraw) and setting (In Word) various formatting attributes. I can add ConvertToRgb on each character in the loop and this will retain individual letter colors, but for a few reasons I want to avoid this. Mainly, I don't want this process altering the original CorelDraw document.
I'm wondering if there is a way to convert the color value instead of converting the shapes color.
Any help is greatly appreciated.
Create a variable that can hold a color then convert that instead of the shapes color:
Dim s As Shape Dim c As New Color Set s = ActiveShape c.CopyAssign s.Fill.UniformColor c.ConvertToRGB
Hope that helps,
-Shelby
There is a Function to Match Colors in a Palette. The following creates the CMYK Color of Yellow, and then matches it to the closest color in the Active Palette. It then returns a message box with the index number of the color in the palette and its name.
Sub PaletteMatchColor() Dim pPalette As Palette Dim cColor As Color Dim i As Integer Set pPalette = ActivePalette Set cColor = CreateCMYKColor(0, 0, 100, 0) cColor.ConvertToRGB i = pPalette.MatchColor(cColor) MsgBox "Index: " & i & ", Name:" & pPalette.Color(i).Name End Sub
Best of luck,
I knew I seen this reference somewhere~ Okay, Below I have my shapes w/the same fill color selected (Lets say all shapes are a yellow tone) . I also have opened my desired Palette and now Im trying to match that (yellow tone) to the nearest yellow tone in my palette. (well any yellow tone). It can decide for me which yellow is closest. Dim s As Shape, sr As ShapeRange Dim pal As Palette Set sr = ActiveSelectionRange set s = s.fill.uniformfill
ActivePage.Shapes.FindShapes(Query:="@fill.color='" & s.Fill.UniformColor.ToString & "'").CreateSelection Set pal = Palettes.Open("C:\Users\cthompson\Documents\Corel\TAC_Palettes\ClassicImpressions.xml") sr.ApplyUniformFill pal.Colors(I'm stuck here) pal.MatchColor (s)?? I guess... I cannot figure out how to get this part of the code to transfer the closest color tone found in my open palette to my selected objects on my page.
Chieri,
Here are two examples. First, if you have a selection you may wish to loop through all the shapes in the selection and match them to your palette. You can do that like this:
Sub MatchColorsToPalette() Dim s As Shape Dim sr As ShapeRange Dim pPalette As Palette Dim i As Long Set pPalette = ActivePalette Set sr = ActiveSelectionRange For Each s In sr.Shapes i = pPalette.MatchColor(s.Fill.UniformColor) s.Fill.ApplyUniformFill pPalette.Color(i) Next s End Sub
This example uses the selected shape to find all other shapes that color. It then fills the found shapes with the matching color from the palette.
Sub MatchColorsToPalette2() Dim s As Shape Dim srFound As ShapeRange Dim pPalette As Palette Dim i As Long Set pPalette = ActivePalette Set s = ActiveShape Set srFound = ActivePage.Shapes.FindShapes(Query:="@fill.color='" & s.Fill.UniformColor.ToString & "'") i = pPalette.MatchColor(s.Fill.UniformColor) srFound.ApplyUniformFill pPalette.Color(i) End Sub