Add pictures in table

[BramGrey]

Good day,



I found a VBA Script that already does what it is suppose to do, but something needs to be adjusted and I can't find how.

Script imports pictures, and places them all underneath each other. (the spacing between them and the title is already perfect) I want them to be added in a table, always 4 pictures next to each other, not only 1 every row.

Somebody able to adjust or tell me how to fix it?

Thanks!!

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