Hello, I've not used VBA in any detail before and now a little out of my depth. I'm trying to modify the code from another post (
Macro to insert 4 pictures per page, picture name, picture references
) for my intended application.

The changes I'm trying to make are;
  • Turn gridline on for the whole table
  • Reduce the white space below the images themselves, row height to be 6 cm
  • Insert additional row below the figure caption so that I can add a description to the images

image.jpg
Any help would be appreciated. 

Option Explicit 
Dim oTbl As Table 
Sub AddPics() 
    Dim lngIndex As Long, lngRowIndex As Long, lngCellIndex As Long, strTxt As String 
    Dim oRng As Range 
    Dim oRow As Row 
    Application.ScreenUpdating = False 
    With Application.FileDialog(msoFileDialogFilePicker) 
        .Title = "Select image files and click OK" 
        .Filters.Add "Images", "*.gif; *.jpg; *.jpeg; *.bmp; *.tif; *.png" 
        .FilterIndex = 2 
        If .Show = -1 Then 
            InsertFittedTable 
            For lngIndex = 1 To .SelectedItems.Count 
                lngRowIndex = Int((lngIndex + 1) / 2) * 3 - 1 
                lngCellIndex = (lngIndex - 1) Mod 2 + 1 
                 'Add extra rows as needed
                If lngRowIndex > oTbl.Rows.Count Then 
                    Set oRng = oTbl.Rows.Last.Cells(1).Range 
                    oRng.Collapse wdCollapseStart 
                    oRng.Select 
                    Selection.InsertRowsBelow 6 
                    oTbl.Rows(oTbl.Rows.Count - 1).Height = oTbl.Rows(oTbl.Rows.Count - 7).Height 
                    oTbl.Rows(oTbl.Rows.Count - 4).Height = oTbl.Rows(oTbl.Rows.Count - 10).Height 
                End If 
                 'Insert the Picture
                ActiveDocument.InlineShapes.AddPicture _ 
                FileName:=.SelectedItems(lngIndex), LinkToFile:=False, _ 
                SaveWithDocument:=True, Range:=oTbl.Rows(lngRowIndex).Cells(lngCellIndex).Range 
                 'Get the Image name for the Caption
                strTxt = Split(.SelectedItems(lngIndex), "\")(UBound(Split(.SelectedItems(lngIndex), "\"))) 
                 'Insert the Caption on the row above the picture
                oTbl.Rows(lngRowIndex - 1).Cells(lngCellIndex).Range.Text = Split(strTxt, ".")(0) 
                Set oRng = oTbl.Rows(lngRowIndex + 1).Cells(lngCellIndex).Range 
                oRng.Text = "Figure - " 
                oRng.Collapse wdCollapseEnd 
                oRng.End = oRng.End - 1 
                ActiveDocument.Fields.Add oRng, wdFieldSequence, "Number" 
            Next 
        End If 
    End With 
    ActiveDocument.Fields.Update 
    Do While Len(oTbl.Rows.Last.Range) = 6 
        oTbl.Rows.Last.Delete 
    Loop 
    Application.ScreenUpdating = True 
lbl_Exit: 
    Exit Sub 
End Sub 
Sub InsertFittedTable() 
    Dim oRow As Row 
    Set oTbl = Selection.Tables.Add(Selection.Range, 6, 2) 
    oTbl.AutoFitBehavior (wdAutoFitFixed) 
    For Each oRow In oTbl.Rows 
        With oRow 
            .Height = CentimetersToPoints(0.75) 
            .HeightRule = wdRowHeightExactly 
            .Range.Style = "Normal" 
            .Range.ParagraphFormat.Alignment = wdAlignParagraphCenter 
        End With 
    Next oRow 
    Do 
        oTbl.Rows(2).Height = oTbl.Rows(2).Height + 5 
        oTbl.Rows(5).Height = oTbl.Rows(2).Height 
    Loop Until oTbl.Rows(6).Range.Information(wdActiveEndPageNumber) > oTbl.Rows(1).Range.Information(wdActiveEndPageNumber) 
    ActiveDocument.Undo 2 
End Sub
Thank-you.