Inserting Mass Images into Word Table -need caption help

[CSMEni]

Hi All! I'm somewhat new to VBA (I can kind of understand the code, but not always) and could use some help editing a macro that I found online. It's designed to insert multiple images into a table in a word doc. The code works fine, but it creates a row for the image (perfect!) and then under that, another row for a caption (not perfect!). I need my caption to be at the top and while I can modify the code to swap them, I can't get it to keep just the one caption and one image per page. With the unedited code, it does that perfectly. When I edit the code to have the caption above the image, it ends up putting a caption row, image, then another caption row >>which would actually go with the image on the following page. I've tried adjusting the size of the caption row (didn't work) and tried various image sizes (didn't work). I'm not sure what else to do.

This is the unedited code that I'm using:

Sub AddPics()
    Application.ScreenUpdating = False
    Dim i As Long, j As Long, c As Long, r As Long, NumCols As Long
    Dim oTbl As Table, TblWdth As Single, StrTxt As String, RwHght As Single
    On Error GoTo ErrExit
    NumCols = CLng(InputBox("How Many Columns per Row?"))
    RwHght = CSng(InputBox("What row height for the pictures, in inches (e.g. 1.5)?"))
    On Error GoTo 0
    'Select and insert the Pics
    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
            'Add a 2-row by NumCols-column table to take the images
            Set oTbl = Selection.Tables.Add(Range:=Selection.Range, NumRows:=2, NumColumns:=NumCols)
            With ActiveDocument.PageSetup
              TblWdth = .PageWidth - .LeftMargin - .RightMargin - .Gutter
            End With
            With oTbl
                .AutoFitBehavior (wdAutoFitFixed)
                .Columns.Width = TblWdth / NumCols
            End With
            CaptionLabels.Add Name:="|"
            For i = 1 To .SelectedItems.Count Step NumCols
                r = ((i - 1) / NumCols + 1) * 2 - 1
                'Format the rows
                Call FormatRows(oTbl, r, RwHght)
                For c = 1 To NumCols
                    j = j + 1
                    'Insert the Picture
                    ActiveDocument.InlineShapes.AddPicture _
                        FileName:=.SelectedItems(j), LinkToFile:=False, _
                        SaveWithDocument:=True, Range:=oTbl.Cell(r, c).Range
                    'Get the Image name for the Caption
                    StrTxt = Split(.SelectedItems(j), "\")(UBound(Split(.SelectedItems(j), "\")))
                    StrTxt = ": " & Split(StrTxt, ".")(0)
                    'Insert the Caption on the row below the picture
                    With oTbl.Cell(r + 1, c).Range
                        .InsertBefore vbCr
                        .Characters.First.InsertCaption _
                        Label:="|", 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
                If j < .SelectedItems.Count Then
                  oTbl.Rows.Add
                  oTbl.Rows.Add
                End If
            Next
        Else
        End If
    End With
ErrExit:
    Application.ScreenUpdating = True
End Sub
'
Sub FormatRows(oTbl As Table, x As Long, Hght As Single)
    With oTbl
        With .Rows(x)
            .Height = InchesToPoints(Hght)
            .HeightRule = wdRowHeightExactly
            .Range.Style = "Normal"
        End With
        With .Rows(x + 1)
            .Height = CentimetersToPoints(0.5)
            .HeightRule = wdRowHeightExactly
            .Range.Style = "Caption"
        End With
    End With
End Sub

I also have another issue I can't figure out. The code makes it so that the caption = "Picture: " then the number of the picture* -and then the file name of the image. *for this, I mean, if there are 20 images, the first image would be number 1, the second image would be number 2, etc. I only want the caption to be the file name of the image.

Thank you in advance!
-D

[gmayor]

Rather than re-invent the wheel take a look at http://www.gmayor.com/photo_gallery_template.html

[CSMEni]

Well, it’s not really recreating the wheel. I found a simple VBA code that will do the job, but I just need to tweak it a bit.

I do appreciate your help and for providing the link to the add-in. It seems to be a handy tool if you work with lots of images/pictures. Unfortunately, it seems a bit tedious to have to download an add-in and walk through all the extra steps when a simple VBA will suffice. I will continue searching for help on VBA code -I’d really like to figure out how to tweak it for my needs.
Thanks again and have a great day!

[macropod]

See: http://www.msofficeforums.com/word-v...es-1-page.html
The instructions there tell you how to insert the caption above the pic.

As for inserting only the pic name, replace all of:

          .InsertBefore vbCr
          .Characters.First.InsertCaption _
          Label:="Picture", Title:=StrTxt, _
          Position:=wdCaptionPositionBelow, ExcludeLabel:=False
          .Characters.First = vbNullString
          .Characters.Last.Previous = vbNullString

with:

          .Text = StrTxt

and replace:

    .Range.Style = "Caption"

with:

    .Range.Style = "TblPic"
    .Range.Paragraphs.Last.KeepWithNext = True

[Srivas]

Rather than re-invent the wheel take a look at (cannot quote the url)

I tried the add-in and, by the way, it's great and just what I need, but somehow after using it, the end result is not exactly as expected. Everything seems to work, except the text from the file names is not appearing. That is, I get a list of photos with the caption placeholders, but no text appears whatsoever. I tried different configuration options, but no text appears. I just need the file names since they are renamed already, so no special configuration or excel list is required. Also, I'm getting no errors while processing, just file names are not there. I'm using Word 2016.

What can be the problem? Thank You!

[gmayor]

Did you check the include filename check box?
If you are still having problems, contact me via my web site.