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 scaleFactor As Long
 Dim max_height As Single
 'define resize constraints
 max_height = 275

 'add a 1 row 2 column table to take the images
 Set oTable = Selection.Tables.Add(Selection.Range, 1, 1)
 '+++++++++++++++++++++++++++++++++++++++++++++
 'oTable.AutoFitBehavior (wdAutoFitFixed)
 oTable.Rows.Height = CentimetersToPoints(4)
 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 = 1
 iRow = i
 'get filename
 picName = Right(.SelectedItems(i), Len(.SelectedItems(i)) - InStrRev(.SelectedItems(i), "\"))
 'remove extension from filename ****
 picName = Left(picName, InStrRev(picName, ".") - 1)

 '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 below image
 oCell.InlineShapes(1).Range.InsertCaption Label:="Figure", TitleAutoText:="", _
 Title:=": " & picName
 If i < .SelectedItems.Count And i Mod 2 = 0 Then 'add another row, more to go
 oTable.Rows.Add
 End If
 Next i
 End If
 End With

 Set fd = Nothing
 End Sub

  'Insert the Caption on the row below the picture
        With oTbl.Cell(r + 1, c).Range
          .InsertBefore vbCr
          .Characters.First.InsertCaption _
          Label:="Foto", Title:=StrTxt, _
          Position:=wdCaptionPositionBelow, ExcludeLabel:=False
          .Characters.First = vbNullString
          .Characters.Last.Previous = vbNullString
        End With
        'Exit when we're done
        If j = .SelectedItems.Count Then Exit For
      Next
      'Add extra rows as needed

CaptionLabels.Add Name:="Foto"

For i = 1 To .SelectedItems.Count Step NumCols