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-vba/16772-4-digital-images-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.