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