need help with macro

The macro code below comes from Sub GDG_John. I modified it to find all the ® symbols and change them to "Arial" font. Works great.

I want it to change the "character position" to "superscript" instead of change the font.

Any help would be greatly appreciated.

Myron

________________________________________________

Sub ChangeFont() 'changes font of ® symbol to arial

    Dim p As Page, s As Shape, t As TextRange, sr As ShapeRange

    Dim i&, myReplaceFont$, myCharacterToFind$, j&

    myCharacterToFind = "®"

    myReplaceFont = "Arial"

    j = ActiveDocument.ActivePage.Index

    For Each p In ActiveDocument.Pages

        p.Activate

        Set sr = ActivePage.Shapes.FindShapes(, cdrTextShape)

            For Each s In sr

                For i = 1 To s.Text.Story.Characters.Count

                    Set t = s.Text.Story.Characters(i)

                    If t = myCharacterToFind Then t.Font = myReplaceFont

                Next i

        Next s

    Next p

    ActiveDocument.Pages(j).Activate

 

 

End Sub