I don't know a sensible way but here is a clunky way ...

Sub apply_Red()
Dim otxr2 As TextRange2
On Error Resume Next
Set otxr2 = ActiveWindow.Selection.TextRange2
If Not otxr2 Is Nothing Then
otxr2.InsertAfter ("A")
otxr2.Font.Fill.ForeColor.RGB = vbRed
SendKeys "{BKSP}"
End If
End Sub