Макрос для поиска определённого объекта в формуле

Sub Макрос()
Dim fChecking As SpellingSuggestions
Dim oSug As SpellingSuggestion
Dim bCheck As Boolean
Dim fld As Field, i As Long
'1. Скрытие кодов полей, если вдруг юзер их отобразил для каких-то своих целей.
ActiveWindow.View.ShowFieldCodes = False
For i = ActiveDocument.Fields.Count To 1 Step -1
    '2. Присваивание программного имени полю.
    Set fld = ActiveDocument.Fields(i)
    ' Если это eq-поле.
    If fld.Type = wdFieldFormula Then
        '3. Выделение поля (с помощью Range не получилось работать).
        fld.Select
        '4. Копирование поля.
        Selection.Copy
        sText = fld.Code
        iLen = Len(sText)
        '5. Вставка поля в виде текста.
        Selection.PasteAndFormat (wdFormatPlainText)
        Selection.MoveLeft Unit:=wdCharacter, Count:=iLen
        Selection.Expand Unit:=wdWord
        If Len(Trim(Selection.Range.Text)) = iLen Then
            bCheck = False
            iSelect = iLen + 1
            For y = 1 To iLen
                iSelect = iSelect - 1
                Selection.MoveLeft Unit:=wdCharacter, Count:=iSelect, Extend:=wdExtend
                sSelected = Selection.Range.Text
                Set fChecking = GetSpellingSuggestions(Word:=sSelected, SuggestionMode:=wdSpellword)
                If fChecking.Count <> 0 Then
                    MsgBox "Слово существует"
                    For Each oSug In fChecking
                        MsgBox oSug.Name
                        bCheck = CheckThisSug(oSug.Name)
                        If bCheck = True Then GoTo ExitLine
                    Next oSug
                        If bCheck = False Then GoTo ContinueLine
                Else
ContinueLine:
                    Selection.Collapse Direction:=wdCollapseEnd
                    Selection.MoveLeft Unit:=wdCharacter, Count:=1
                End If
            Next y
        Else
            iNewLen = Len(Trim(Selection.Range.Text))
            Selection.Collapse Direction:=wdCollapseStart
            Selection.MoveRight Unit:=wdCharacter, Count:=iNewLen
            Selection.MoveRight Unit:=wdCharacter, Count:=iLen - iNewLen, Extend:=wdExtend
            Selection.Range.Delete
            iLen = iNewLen
            iSelect = iNewLen + 1
            For Z = 1 To iLen
                iSelect = iSelect - 1
                Selection.MoveLeft Unit:=wdCharacter, Count:=iSelect, Extend:=wdExtend
                sSelected = Selection.Range.Text
                Set fChecking = GetSpellingSuggestions(Word:=sSelected, SuggestionMode:=wdSpellword)
                If fChecking.Count <> 0 Then
                    'MsgBox "Слово существует"
                    For Each oSug In fChecking
                        MsgBox oSug.Name
                        bCheck = CheckThisSug(oSug.Name)
                        If bCheck = True Then GoTo ExitLine
                    Next oSug
                        If bCheck = False Then GoTo ContinueLine2
                Else
ContinueLine2:
                    Selection.Collapse Direction:=wdCollapseEnd
                    Selection.MoveLeft Unit:=wdCharacter, Count:=1
                End If
            Next Z
        End If
    End If
Next i

ExitLine:
Selection.Collapse Direction:=wdCollapseStart
Selection.MoveRight Unit:=wdCharacter, Count:=iLen, Extend:=wdExtend
Selection.Range.Text = oSug.Name
'5. Сообщение, чтобы юзер понял, что макрос закончил работу.
MsgBox "Готово.", vbInformation
End Sub
Function CheckThisSug(ByVal sName As String) As Boolean
    If InStr(sName, Chr(32)) >= 1 Then
        CheckThisSug = False
    Else
        CheckThisSug = True
    End If
End Function

Sub Макрос()
Dim fld As Field, i As Long
'1. Скрытие кодов полей, если вдруг юзер их отобразил для каких-то своих целей.
ActiveWindow.View.ShowFieldCodes = False
For i = ActiveDocument.Fields.Count To 1 Step -1
    '2. Присваивание программного имени полю.
    Set fld = ActiveDocument.Fields(i)
    ' Если это eq-поле.
    If fld.Type = wdFieldFormula Then
        '3. Выделение поля (с помощью Range не получилось работать).
        fld.Select
        '4. Копирование поля.
        Selection.Copy
        sText = fld.Code
        iLen = Len(sText)
        '5. Вставка поля в виде текста.
        Selection.PasteAndFormat (wdFormatPlainText)
        Selection.MoveLeft Unit:=wdCharacter, Count:=iLen
        Selection.Expand Unit:=wdWord
        sWord = Trim(Selection.range.text)
        Selection.Collapse Direction:=wdCollapseStart
        Selection.MoveRight Unit:=wdCharacter, Count:=Len(sWord)
        Selection.MoveRight Unit:=wdCharacter, Count:=iLen - Len(sWord), Extend:=wdExtend
        Selection.Range.Delete
'5. Сообщение, чтобы юзер понял, что макрос закончил работу.
MsgBox "Готово.", vbInformation
End Sub

Sub CleanAntiPlagiat()
'
Dim orng As Range, i As Long, fld As Field

For i = ActiveDocument.Fields.Count To 1 Step -1
    Set fld = ActiveDocument.Fields(i)
    
'  Обрабатываем eq-поле.
    If fld.Type = wdFieldFormula Then
        fld.ShowCodes = True
        Set orng = fld.Code
        orng.Start = orng.Start + 3
        orng.End = orng.End - 1
        orng.Copy
        fld.Delete
        orng.Paste
    End If
Next i
    
    Set orng = ActiveDocument.Content
    orng.Find.ClearFormatting
    orng.Find.Replacement.ClearFormatting
    With orng.Find
        .Text = "^?"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindStop
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        
        Do While .Execute
           If orng.Font.Spacing < 0 Or orng.Font.Color = wdColorWhite Then orng.Delete
        Loop
        
    End With
End Sub