Создание макроса для Word со ссылками на элементы библиотеки переводов в Excel

Sub ZAMENA()
'
' ZAMENA Macro
'
'
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "PROPOSAL OF EQUIPMENT FOR"
        .Replacement.Text = "Предложение оборудования"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub

Sub ExcelDictionary()
    Dim xl As Object, wbk As Object, wsh As Object
    
    Set xl = CreateObject("Excel.Application")
    Set wbk = xl.Workboos.Open(ThisDocument.Path & "\dict.xlsx")
    Set wsh = wbk.Worksheets(1)
    
    ' Здесь можно обращаться к первому листу "словаря" dict.xlsx
    ' как к объекту с именем wsh
    
    Set wsh = Nothing
    wbk.Close False
    Set wbk = othing
    xl.Exit
    Set xl = Nothing
End Sub

Sub ExcelDictionary()
    Dim xl As Object, wbk As Object, wsh As Object, rn As Object, r As Long
    
    Set xl = CreateObject("Excel.Application")
    Set wbk = xl.Workbooks.Open(ThisDocument.Path & "\dict.xlsx")
    Set wsh = wbk.Worksheets(1)
    Set rn = wsh.Cells
    For r = 2 To 65536
      If rn(r, 1) = "" Then Exit For
      With Selection.Find
          .ClearFormatting
          .Replacement.ClearFormatting
          .Text = rn(r, 1)
          .Replacement.Text = rn(r, 2)
          .Forward = True
          .Wrap = wdFindContinue
          .Format = False
          .MatchCase = False
          .MatchWholeWord = False
          .MatchWildcards = False
          .MatchSoundsLike = False
          .MatchAllWordForms = False
          .Execute Replace:=wdReplaceAll
      End With
    Next r
    Set rn = Nothing
    Set wsh = Nothing
    wbk.Close False
    Set wbk = Nothing
    xl.Quit 'exit?
    Set xl = Nothing
End Sub

Sub ExcelDictionary()
    Dim xl As Object, wbk As Object, wsh As Object
    Dim dict(), i As Long
    
    Set xl = CreateObject("Excel.Application")
    Set wbk = xl.Workbooks.Open(ThisDocument.Path & "\dict.xlsx")
    Set wsh = wbk.Worksheets(1)
    
    ' Получить содержание словаря в массив
    dict = wsh.Cells(2, 1).Resize(wsh.Cells(wsh.Rows.Count, 1).End(-4162).Row - 1, 1).Value
    
    Set wsh = Nothing
    wbk.Close False
    Set wbk = Nothing
    xl.Quit
    Set xl = Nothing
    
    ' Перебрать весь словарь, заменять все найденные пары
    With ActiveDocument.Content.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        For i = 1 To UBound(dict, 1)
            .Text = dict(i, 1)
            .Replacement.Text = dict(i, 1)
            .Execute Replace:=wdReplaceAll
        Next
    End With
End Sub

.Replacement.Text = dict(i, 2)