Sub Test() Dim s As Shape, sr As ShapeRange Set s = ActiveLayer.CreateArtisticText(0, 0, "O") With s.Text.FontProperties .Name = "Arial Black" .Size = 48 End With s.ConvertToCurves s.BreakApart Set sr = ActiveSelectionRange sr(1).Move 0, 0.2 sr.CombineEnd Sub