Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "3"
        .Replacement.Text = "3"
        .Forward = True
        .Replacement.Font.Superscript = wdToggle
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

Set w = CreateObject("Word.Application")
Set doc = w.Documents.Add("D:\1.doc")
w.ActiveDocument.Windows( 1 ).Activate
w.ActiveDocument.Windows( 1 ).Visible = True

Set myFind = w.ActiveDocument.Range( 0 )
myFind.Select
    
myFind.Find.ClearFormatting
myFind.Find.Replacement.ClearFormatting

With myFind.Find
    .Forward = True
    .Text = "3"
    .Wrap = wdFindAsk
    .Replacement.Text = "4"
    .Replacement.Font.Superscript =  1 
End With

        'допустим для примера
        Set w = CreateObject("Word.Application")
        Set doc = w.Documents.Add("D:\1.doc")

        'ищем "м3" и "м2" в обычном написании и заменяем на надстрочное
        Set MyRange = doc.Application.ActiveDocument.Content
        MyRange.Find.Font.Superscript =  0 
        MyRange.Find.Replacement.Font.Superscript =  1 
        MyRange.Find.Execute FindText:="м3", ReplaceWith:="м3", Replace:= 2 
        MyRange.Find.Execute FindText:="м2", ReplaceWith:="м2", Replace:= 2 
       
        'ищем "м" в надстрочном написании и заменяем на обычное
        Set MyRange = doc.Application.ActiveDocument.Content
        MyRange.Find.Font.Superscript =  1 
        MyRange.Find.Replacement.Font.Superscript =  0 
        MyRange.Find.Execute FindText:="м", ReplaceWith:="м", Replace:= 2