Sub MyMacro1()

Dim i As Long ' a shape's canvas item index
On Error Resume Next '!
y = Selection.Range.ShapeRange(1).CanvasItems.Count
'MsgBox Selection.Range.ShapeRange(1).CanvasItems(2).Name
For i = 1 To y
    If Selection.Range.ShapeRange(1).CanvasItems(i).TextFrame.HasText Then
'    Selection.Range.ShapeRange(1).CanvasItems(i).TextFrame.TextRange.Font.Name = "Times New Roman"
    Selection.Range.ShapeRange(1).CanvasItems(i).TextFrame.TextRange.Font.ColorIndex = wdBrightGreen
    End If
Next
'    WdColorIndex enumeration(Word)
' wdAuto            0   Automatic color. Default; usually black.
'wdBlack            1   Black color.
'wdBlue             2   Blue color.
'wdBrightGreen      4   Bright green color.
'wdByAuthor         -1  Color defined by document author.
'wdDarkBlue         9   Dark blue color.
'wdDarkRed          13  Dark red color.
'wdDarkYellow       14  Dark yellow color.
'wdGray25           16  Shade 25 of gray color.
'wdGray50           15  Shade 50 of gray color.
'wdGreen            11  Green color.
'wdNoHighlight      0   Removes highlighting that has been applied.
'wdPink             5   Pink color.
'wdRed              6   Red color.
'wdTeal             10  Teal color.
'wdTurquoise        3   Turquoise color.
'wdViolet           12  Violet color.
'wdWhite            8   White color.
'wdYellow           7   Yellow color.
End Sub