Для обернутых объектов с ранним связыванием:
Dim wdApp As New Word.Application, wdDoc As Word.Document
Dim wdShp As Word.Shape, wdRng As Word.Range, i As Long, Fmt As Long, StrID As String, StrNm As String
Dim vRel As Long, vPos As Single, hRel As Long, hPos As Single, Hght As Single, Wdth As Single
Const strPath As String = "New Path"
With wdApp
.Visible = True
Set wdDoc = .Documents.Open(Filename:="C:\Users\" & Environ("Username") & "\Documents\Target Document.docx", _
AddToRecentFiles:=False, Visible:=True)
With wdDoc
For i = .Shapes.Count To 1 Step -1
With .Shapes(i)
If Not .LinkFormat Is Nothing Then
Set wdRng = .Anchor: StrID = .OLEFormat.progID: StrNm = "\" & .LinkFormat.SourceName
Fmt = .WrapFormat.Type: Hght = .Height: Wdth = .Width
vRel = .RelativeVerticalPosition: vPos = .Top
hRel = .RelativeHorizontalPosition: hPos = .Left
.Delete
With wdRng
.Fields.Add Range:=.Duplicate, Type:=wdFieldEmpty, PreserveFormatting:=False, _
Text:="LINK " & StrID & " " & Chr(34) & Replace(strPath & StrNm, "\", "\\") & Chr(34) & " " & _
"6 - EW_RA!R2C17" & " \p"
.End = .End + 1
Set wdShp = .Fields(1).InlineShape.ConvertToShape
End With
With wdShp
.WrapFormat.Type = Fmt: .Height = Hght: .Width = Wdth
.RelativeVerticalPosition = vRel: .Top = vPos
.RelativeHorizontalPosition = hRel: .Left = hPos
End With
End If
End With
Next
.Close True
End With
.Quit
End With