Can't vertically align artistic text to object in VBA

This is what my code (most of it copied) looks like so far:

Sub LabelSwatches()
  Dim sr As ShapeRange, sh As Shape, cn As Shape, col As Color
  ActiveDocument.Unit = cdrInch
  Set sr = ActiveSelectionRange
  If sr.Count = 0 Then MsgBox "SELECT SOMETHING DAMNIT!": Exit Sub
    ActiveDocument.BeginCommandGroup "ColorsNames"
      For Each sh In sr
       Set col = sh.Fill.UniformColor
       Set cn = ActiveDocument.ActiveLayer.CreateArtisticText(sh.RightX, sh.CenterY, col.Name, cdrEnglishUS, , "Arial", sh.SizeWidth / 500, , , , cdrCenterAlignment)
       cn.Fill.ApplyUniformFill CreateCMYKColor(0, 99, 100, 0)
     Next sh
    ActiveDocument.EndCommandGroup
End Sub

I would really appreciate it if someone could help me vertically align the color names to the selected object!!! I would cry TEARS OF JOY!

  • Exactly how do you want the color name to be aligned with respect to the swatch?

    If I want the text label to be centered on the swatch in both X and Y, then adding this after the creation of the text accomplishes that:

    cn.CenterX = sh.CenterX
    cn.CenterY = sh.CenterY

    If I want the text label centered on the swatch in X, but 0.1" above the top of the shape, then this instead:

    cn.CenterX = sh.CenterX
    cn.BottomY = sh.TopY + 0.1

    If I want the text label centered on the swatch in Y, but 0.1" to the right of the shape, then this instead:

    cn.LeftX = sh.RightX + 0.1
    cn.CenterY = sh.CenterY

    • I'll add here that, when I first tried this, the labels were really small.

      Your code sets the font size (in points) by dividing the width of the labeled object by 500.

      For my testing, I chose to make the font size much larger than that.