Public Sub SetSubScript(RTB As RichTextBox)
Dim iPos As Long
Dim strRTF As String
        With RTB
        If .SelCharOffset >= 0 Then
        'subscript the current selection
            iPos = .SelStart
            .SelText = Chr(&H9D) & .SelText & Chr(&H81)
            strRTF = Replace(.TextRTF, "\'9d", "\sub\dn2 ")
            .TextRTF = Replace(strRTF, "\'81", "\nosupersub\up0 ")
            .SelStart = iPos
        Else 'turn off subscripting
            .SelText = Chr(&H9D) & .SelText
            strRTF = .TextRTF
            .TextRTF = Replace(strRTF, "\'9d", "\nosupersub\up0 ", , 1)
        End If
        End With
End Sub

Public Sub SetSuperScript(RTB As RichTextBox)
'add tags \super\up1 and \nosupersub\up0
Dim iPos As Long
Dim strRTF As String
      With RTB
        iPos = .SelStart
        If RTB.SelCharOffset <= 0 Then
        'superscript the current selection
            .SelText = Chr(&H9D) & .SelText & Chr(&H80)
            strRTF = Replace(.TextRTF, "\'9d", "\super\up2 ")
            .TextRTF = Replace(strRTF, "\'81", "\nosupersub\up0 ")
        Else 'turn off
            .SelText = Chr(&H9D) & .SelText
            strRTF = .TextRTF
            .TextRTF = Replace(strRTF, "\'9d", "\nosupersub\up0 ", , 1)
        End If
        .SelStart = iPos
       End With
End Sub