GDG Code Chunks, Discussion, VBA Snippets for CorelDRAW, Simple Macro Helpers!

MyAccount

Helpful VBA Code

<<Back to helpful code list

Add color name under each shape

Decription: This code will create an artistic text under each shape that statees the colors name.

Date: 2010-05-04 Author: John

Code:

Option Explicit

Sub nameMyColor()
 Dim x#, y#
 Dim x1#, y1#, w1#, h1#
 Dim Shift As Long
 Dim b As Boolean
 Dim s As Shape
 Dim textUnder As Shape
 Dim textStr1 As String
 Dim textStr2 As String
 On Error GoTo 1000
 b = False
 While Not b
  b = ActiveDocument.GetUserClick(x, y, Shift, 10, False, cdrCursorEyeDrop)
  If Not b Then
    Set s = ActivePage.SelectShapesAtPoint(x, y, False)
    textStr1 = s.Fill.UniformColor.Name
    If s.Fill.UniformColor.IsCMYK Then
        textStr2 = "CMYK " & s.Fill.UniformColor.CMYKCyan & ", " & s.Fill.UniformColor.CMYKMagenta & ", " & s.Fill.UniformColor.CMYKYellow & ", " & s.Fill.UniformColor.CMYKBlack
    Else
        textStr2 = "RGB " & s.Fill.UniformColor.RGBRed & ", " & s.Fill.UniformColor.RGBGreen & ", " & s.Fill.UniformColor.RGBBlue
    End If
    s.GetBoundingBox x1, y1, w1, h1
    Set textUnder = ActiveLayer.CreateArtisticText(x1 + (w1 / 3), y1 - 0.2, textStr1 & vbNewLine & textStr2, , , , 9)
    s.AlignToShape cdrAlignVCenter, textUnder
  End If
 Wend
1000:
End Sub

Add Comment, Question, Discussion...