View Single Post
 
Old 10-23-2020, 02:11 AM
Ethen5155 Ethen5155 is offline Windows 10 Office 2016
Novice
 
Join Date: Nov 2019
Posts: 5
Ethen5155 is on a distinguished road
Default

Thanks to José Augusto

Solved

Code:
Sub LinkImagesToTable()
'
Dim File_Path As String, Image_Path As String, Image_Name As String, Image_Aux As String, Row_i As Integer
On Error Resume Next
File_Path = ActiveDocument.Path
Image_Path = File_Path & "\Links"
    For Row_i = 2 To ActiveDocument.Tables(1).Rows.Count
        Image_Aux = ActiveDocument.Tables(1).Cell(Row_i, 1).Range
        Image_Name = Trim(Left(Image_Aux, Len(Image_Aux) - 2) & ".jpg")
        ActiveDocument.Tables(1).Cell(Row_i, 2).Select
        Selection.Range = ""
        ActiveDocument.Shapes.AddPicture(Anchor:=Selection.Range, FileName:= _
            Image_Path & "\" & Image_Name, _
            LinkToFile:=True, SaveWithDocument:=True).WrapFormat.Type = wdWrapSquare
        DoEvents
    Next Row_i
    For Row_i = 1 To ActiveDocument.Shapes.Count
        With ActiveDocument.Shapes(Row_i)
            .RelativeHorizontalPosition = 2
            .RelativeVerticalPosition = 1
            .Top = 0
        End With
        DoEvents
    Next Row_i
End Sub
Reply With Quote