Microsoft Office Forums - View Single Post - [Solved] Insert multiple pictures at once in Word table

Guessed · 11-29-2022, 04:15 PM

At its most basic, assume your PNGs are all in the same folder as the Word document. Then this code will iterate through a column of text to add the corresponding image in the preceding cell

Code:

Sub InsertImages()
  Dim aCell As Cell, sPath As String, sFile As String, aTbl As Table, iCol As Integer
  Dim aRng As Range, aShp As InlineShape
  
  Set aTbl = Selection.Tables(1)
  iCol = Selection.Cells(1).Column.Index
  sPath = ActiveDocument.Path & Application.PathSeparator
  For Each aCell In aTbl.Columns(iCol).Cells
    sFile = sPath & Split(aCell.Range.Text, vbCr)(0) & ".png"
    If Len(Dir(sFile)) > 0 Then
      Debug.Print sFile
      Set aRng = aCell.Previous.Range
      Set aShp = ActiveDocument.InlineShapes.AddPicture(FileName:=sFile, Range:=aRng)
      aShp.AlternativeText = sFile
      aShp.Width = CentimetersToPoints(0.8)
      aShp.Height = CentimetersToPoints(0.8)
      aRng.Cells(1).VerticalAlignment = wdCellAlignVerticalCenter
      aRng.Cells(1).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
    End If
  Next aCell
End Sub