opens dialog, all selected files are inserted with captions containing chapter indices - filename as the caption content

insertMultiFileWCap.vba

Sub InsertMultipleImages()
    Dim fd As FileDialog
    Dim oTbl As Table
    Dim oILS As InlineShape
    Dim oRng As Range
    Dim rngHead As Range
    Dim vrtSelectedItem As Variant
    
    If Documents.Count = 0 Then
        If MsgBox("No document open!" & vbCr & vbCr & _
        "Do you wish to create a new document to hold the images?", _
        vbYesNo, "Insert Images") = vbYes Then
        Documents.Add
    Else
        Exit Sub
    End If
End If
'Add a 1 row 2 column table to take the images
'Set oTbl = Selection.Tables.Add(Selection.Range, 1, 2)
' oTbl.AutoFitBehavior (wdAutoFitFixed)
Dim currentChapter
Set oRng = Selection.Range
Set rngHead = oRng.GoTo(what:=wdGoToHeading, Which:=wdGoToPrevious, Count:=1).Paragraphs(1).Range
    rngHead.MoveEnd Unit:=wdCharacter, Count:=-1
currentChapter = rngHead.Text

With CaptionLabels(wdCaptionFigure)
 .IncludeChapterNumber = True
 .ChapterStyleLevel = 2
 .NumberStyle = wdCaptionNumberStyleArabic
 
 
 
End With
' Selection.InsertCaption Label:="Figure", TitleAutoText:="", Title:="." & _
'                  " " & currentChapter, Position:=wdCaptionPositionBelow, ExcludeLabel:=0

If MsgBox("Chapter no " & vbCr & currentChapter & _
        "", _
        vbYesNo, "Insert Images") = vbNo Then
        Exit Sub
End If
    

Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
    .Title = "Select image files and click OK"
    .Filters.Add "Images", "*.gif; *.jpg; *.jpeg; *.bmp; *.tif; *.png"
    .FilterIndex = 2
    If .Show = -1 Then
        Dim i As Integer
        i = 0
        'prepare some space
        For Each vrtSelectedItem In .SelectedItems
        Selection.InsertAfter (vbCr)
        Next vrtSelectedItem
        Selection.MoveUp Unit:=wdLine, Count:=1
        Selection.GoToNext what:=wdGoToLine
        
        For Each vrtSelectedItem In .SelectedItems
        
        Dim fName As String
        Dim fFolderName As String
        fName = Right$(vrtSelectedItem, Len(vrtSelectedItem) - InStrRev(vrtSelectedItem, "\"))
        fFolderName = Right$(vrtSelectedItem, Len(vrtSelectedItem) - InStrRev(vrtSelectedItem, "\"))
        i = i + 1
            With Selection
                Set oILS = .InlineShapes.AddPicture(FileName:= _
                vrtSelectedItem, LinkToFile:=False, SaveWithDocument:=True, _
                Range:=Selection.Range)
                oILS.Range.InsertCaption Label:="Figure", TitleAutoText:="", Title:="." _
                 & " " & currentChapter & "-" & fName, Position:=wdCaptionPositionBelow, ExcludeLabel:=0
                
'                .MoveRight wdCell, 1
            End With
           
            Selection.MoveDown Unit:=wdLine, Count:=2 'move past picture and caption, since insertion doesnt change the position
            
            
            Next vrtSelectedItem
        Else
        End If
    End With
    'If Len(oTbl.Rows.Last.Cells(1).Range) = 2 Then oTbl.Rows.Last.Delete
    Set fd = Nothing
'    With CaptionLabels(wdCaptionTable)
' .IncludeChapterNumber = True
' .ChapterStyleLevel = 2
'End With
End Sub