Sub InsertMultipleImagesFixed()
Dim fd As FileDialog
Dim oTable As Table
Dim iRow As Integer
Dim iCol As Integer
Dim oCell As Range
Dim i As Long
Dim sNoDoc As String
Dim picName As String
Dim scale_Factor As Long
Dim max_height As Single
'define resize constraints
max_height = 144  ' 2 inches = 144 pt

'add a 1 row 4 column table to take the images
Set oTable = Selection.Tables.Add(Selection.Range, 1, 4)
'+++++++++++++++++++++++++++++++++++++++++++++
'oTable.AutoFitBehavior (wdAutoFitFixed)
oTable.Rows.Height = InchesToPoints(2.1)
oTable.Range.Cells.VerticalAlignment = wdCellAlignVerticalCenter
'++++++++++++++++++++++++++++++++++++++++++++++

Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.Title = "Select image files and click OK"
.Filters.Add "Images", "*.gif; *.jpg; *.jpeg; *.bmp; *.tif; *.png; *.wmf"
.FilterIndex = 2
If .Show = -1 Then

For i = 1 To .SelectedItems.Count

iCol = 4
iRow = i
'get filename
'picName = Right(.SelectedItems(i), Len(.SelectedItems(i)) - InStrRev(.SelectedItems(i), "\"))
''remove extension from filename ****
'picName = Left(picName, InStrRev(picName, ".") - 1)
picName = WordBasic.FilenameInfo(.SelectedItems(i), 4)

'select cell
Set oCell = ActiveDocument.Tables(1).Cell(iRow, iCol).Range

'insert image
oCell.InlineShapes.AddPicture FileName:= _
.SelectedItems(i), LinkToFile:=False, _
SaveWithDocument:=True, Range:=oCell

'resize image
If oCell.InlineShapes(1).Height > max_height Then
scale_Factor = oCell.InlineShapes(1).ScaleHeight * (max_height / oCell.InlineShapes(1).Height)
oCell.InlineShapes(1).ScaleHeight = scale_Factor
oCell.InlineShapes(1).ScaleWidth = scale_Factor
End If

'center content
oCell.ParagraphFormat.Alignment = wdAlignParagraphCenter

'insert caption in column 4, then move it to column 3
oCell.InlineShapes(1).Range.InsertCaption Label:="Figure", TitleAutoText:="", _
Title:=": " & picName
oCell.Paragraphs(2).Range.Cut
ActiveDocument.Tables(1).Cell(iRow, iCol - 1).Range.Paste
If i < .SelectedItems.Count Then  'add another row, more to go
oTable.Rows.Add
End If
Next i
End If
End With

Set fd = Nothing
End Sub