ActiveDocument.Select
  Sel$ = Selection
  len1 = Len(Sel$)
  
  len2 = ActiveDocument.Characters.Count

  If len1<>len2 Then MsgBox "I hate Microsoft!!!!"

Function GetWord(FromCharacter, WordLength As Long) As String
Dim i As Long
Dim s As String
For i = FromCharacter To FromCharacter + WordLength -  1 
  s = s + ActiveDocument.Characters(i)
Next i
GetWord = s
End Function 

Selection.Text = Sel$

Sub AssignSelectionCharacter(FromCharacter As Long, NewText As String)
'В текущем Selection присваются в Character, начиная с FromCharacter посимвольно
'слово NewText
Dim i As Long
For i =  1  To Len(NewText)
   ActiveDocument.Characters(FromCharacter + i -  1 ) = Mid$(NewText, i,  1 )
Next i
End Sub 'AssignSelectionCharacter

Sub AssignSelectionCharacter(FromCharacter, sellen, actlen As Long, NewText, OldText As String)
'В текущем Selection присваются в Character, начиная с FromCharacter посимвольно
'слово NewText
Dim i, j, k As Long
Dim NotMatching As Boolean
Dim s1, s2, s3 As String

If sellen = actlen Then 'Не надо изощряться
  k =  0 : GoTo aa1
End If

If sellen > actlen Then 'Надо уменьшать индекс для ActiveDocument, k - отрицательное
  NotMatching = True
  s1 = Mid$(OldText,  1 ,  1 ) 'Первый символ для поиска совпадений
  k =  1  'Потом сразу уменьшим на 1.
  While NotMatching
    k = k -  1 
    If k < (actlen - sellen -  1 ) Then 'Что-то совсем неправильно
      MsgBox "Невозможно заменить слово"
      Exit Function
    End If
    If ActiveDocument.Characters(FromCharacter + k) <> s1 Then
      
    Else
      NotMatching = False
      For j =  1  To Len(OldText)
        s2 = Mid$(OldText, j,  1 )
        s3 = ActiveDocument.Characters(FromCharacter + j -  1  + k)
        If s2 <> s3 Then
          NotMatching = True
          Exit For
        End If 's2
      Next j
    End If 's1 совпал
  Wend 'NotMatching
End If 'sellen>actlen
GoTo aa1

If sellen < actlen Then 'Надо увеличивать индекс для ActiveDocument, k - положительное
  NotMatching = True
  s1 = Mid$(OldText,  1 ,  1 ) 'Первый символ для поиска совпадений
  k = - 1  'Потом сразу увеличим на 1.
  While NotMatching
    k = k +  1 
    If k > (actlen - sellen +  1 ) Then 'Что-то совсем не так.
      MsgBox "Невозможно заменить слово"
      Exit Function
    End If
    If ActiveDocument.Characters(FromCharacter + k) <> s1 Then
      
    Else
      NotMatching = False
      For j =  1  To Len(OldText)
        s2 = Mid$(OldText, j,  1 )
        s3 = ActiveDocument.Characters(FromCharacter + j -  1  + k)
        If s2 <> s3 Then
          NotMatching = True
          Exit For
        End If 's2
      Next j
    End If 's1 совпал
  Wend 'NotMatching
End If 'sellen>actlen
GoTo aa1


aa1: For i =  1  To Len(NewText)
   s3 = ActiveDocument.Characters(FromCharacter + i -  1  + k)
   ActiveDocument.Characters(FromCharacter + i -  1  + k) = Mid$(NewText, i,  1 )
Next i

End Sub 'AssignSelectionCharacter

Dim i, j, k As Long
Dim NotMatching As Boolean
Dim s1, s2, s3 As String