Perhaps this is being over-thought. This works if you have selected a text box inside a Canvas
Code:
Sub Macro1()
If Selection.ShapeRange.Count > 0 Then
Selection.WholeStory 'needed if selection is inside textbox rather than being the textbox
Selection.Font.ColorIndex = wdRed
End If
End Sub