Sub FmtFraction()
 Dim sFraction() As String
 Dim sChar As String
 'Check if a fraction is selected
 'and if not show a warning and exit
 If InStr(Selection, "/") = False Then
  MsgBox "No fraction selected!", vbCritical, "Format Fraction"
  Exit Sub
 End If
 'Define a new slash character
 sChar = ChrW(&H2044)
 'Split the original fraction at the slash character
 sFraction = Split(Selection, "/")
 'Reformat the fraction using super and subscript
 With Selection
  .Font.Superscript = True
  .TypeText Text:=sFraction(0)
  .Font.Superscript = False
  .TypeText Text:=sChar
  .Font.Subscript = True
   TypeText Text:=sFraction(1)
  .Font.Subscript = False
 End With
 End Sub

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