[/src]Sub kvadratiki()

Dim z As Boolean
Dim ar() As String
ReDim Preserve ar( 1 ,  1 )
ActiveDocument.Select
On Error GoTo lab1
With Selection.Find
            .Text = Chr( 13 )
End With
en = Selection.Information(wdEndOfRangeRowNumber)

While z = False
   Selection.Find.Execute
   x = Selection.Information(wdFirstCharacterLineNumber)
   Selection.MoveRight  1 ,  1 
   y = Selection.Information(wdFirstCharacterLineNumber)
   If x = y Then
          Selection.MoveLeft  1 ,  1 ,  1 
          Selection.TypeText Text:="ЁЁ"
    End If
Wend
lab1:
    MsgBox "Ïîèñê çàâåðøåí"
 
End Sub
[SRC VB]