Letters to curves - macros for changing letters

You can write all your texts (names) and then run macro that will browse through active page find all texts, create underline to texts (somehow defined, in my sample code it’s based on source text bounding box dimensions) and weld this underline with duplicated text (then you get one object in curves underlined name) and under that object you will still have original texts.

Sub test()
Dim ul As Shape, sh As ShapeRange, s As Shape, sc As Shape, w#, h#, x#, y#
Set sh = ActivePage.FindShapes(Type:=cdrTextShape)
ActiveDocument.BeginCommandGroup ("underline")
For Each s In sh
If s.Text.Type = cdrArtisticText Then
s.GetBoundingBox x, y, w, h
Set ul = ActiveLayer.CreateRectangle2(x - (0.5 * w / 20), y - (0.5 * h / 10), w + (0.5 * w / 20), h / 10)
ul.Fill.CopyAssign s.Fill
Set sc = s.Duplicate.Weld(ul)
Else:
End If
Next s
ActiveDocument.EndCommandGroup
End Sub

Best regards

Mek