Sub Fraction()
Dim RngTmp As Range, StrFrac
With Selection
  If InStr(.Text, "/") < 2 Then GoTo ErrMsg
  While Not .Characters.Last.Text Like "[0-9]"
    .End = .End - 1
    If .Start + InStr(.Text, "/") = .End Then GoTo ErrMsg
  Wend
  While Not .Characters.First.Text Like "[0-9]"
    .Start = .Start + 1
    If .Start = .End Or InStr(.Text, "/") = 0 Then GoTo ErrMsg
  Wend
  StrFrac = Split(.Text, "/")
  Set RngTmp = .Range
  With RngTmp
    .Font.Size = Round(.Font.Size * 1.75) / 2
    .End = .Start + Len(StrFrac(0))
    .Font.Superscript = True
    .Characters.Last.Next.Font.Italic = True
    .End = Selection.End
    .Start = .Start + InStr(.Text, "/")
    .Font.Subscript = True
  End With
End With
Set RngTmp = Nothing
Exit Sub
ErrMsg:
MsgBox "No fraction selected!", vbCritical, "Format Fraction"
End Sub