What to add to macro to attach file names to inserted batch pictures?

[ricmo]

Hello-

The following macro allows me to batch insert inventory pictures into a word.doc 6 to a page. 2 columns, 3 rows. I would like to add the file names as captions as well because the file names describe the items in the pictures. Also, is it possible to have the images and the file names linked so they can be moved together?

What lines of code do I need to add to achieve this goal? I will have over 1000 photos of inventory that I will need to put into the doc and organize.

Thank you in advance for any and all help.


'Sub InsertMultipleImages()
Dim fd As FileDialog
Dim oTable As Table
Dim iRow As Integer
Dim iCol As Integer
Dim oCell As Range
Dim i As Long
Dim sNoDoc As String
If Documents.Count = 0 Then
sNoDoc = MsgBox(" " & _
"No document open!" & vbCr & vbCr & _
"Do you wish to create a new document to hold the images?", _
vbYesNo, "Insert Images")
If sNoDoc = vbYes Then
Documents.Add
Else
Exit Sub
End If
End If
'add a 1 row 2 column table to take the images
Set oTable = Selection.Tables.Add(Selection.Range, 1, 2)
'+++++++++++++++++++++++++++++++++++++++++++++
oTable.AutoFitBehavior (wdAutoFitFixed)
oTable.Rows.Height = CentimetersToPoints(7)
oTable.Range.Cells.VerticalAlignment = wdCellAlignVerticalCenter
'++++++++++++++++++++++++++++++++++++++++++++++
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
For i = 1 To .SelectedItems.Count
If i Mod 2 = 0 Then
iRow = i / 2
iCol = 2
Else
iRow = (i + 1) / 2
iCol = 1
End If
Set oCell = oTable.Cell(iRow, iCol).Range
oCell.InlineShapes.AddPicture FileName:= _
.SelectedItems(i), _
LinkToFile:=False, _
SaveWithDocument:=True, _
Range:=oCell
oCell.ParagraphFormat.Alignment = wdAlignParagraphCenter
If i < .SelectedItems.Count And i Mod 2 = 0 Then
oTable.Rows.Add
End If
Next i
End If
End With
Set fd = Nothing
End Sub

[Frosty]

Someone else wrote this code for you, yes? I think it's a terribly bad practice to dimension something with a name to make it look like something else... i.e.,
Dim oCell As Range

So I have changed that one piece of the procedure to indicate it is what is actually is...
Dim rngCell As Range

Other than that, you basically just need to insert a new paragraph above the inline shape you've inserted into the table cell, with the info you want.

Other than "Keep With Next", there is no real way to link the two things, as they are distinct elements, and you will need to select the two of them when you move. However, since they are in the same table cell, it should be fairly easy to move without mistake.

Hope this helps:

Sub InsertMultipleImages()
Dim fd As FileDialog
Dim oTable As Table
Dim iRow As Integer
Dim iCol As Integer
Dim rngCell As Range
Dim i As Long
Dim sNoDoc As String
If Documents.Count = 0 Then
sNoDoc = MsgBox(" " & _
"No document open!" & vbCr & vbCr & _
"Do you wish to create a new document to hold the images?", _
vbYesNo, "Insert Images")
If sNoDoc = vbYes Then
Documents.Add
Else
Exit Sub
End If
End If
'add a 1 row 2 column table to take the images
Set oTable = Selection.Tables.Add(Selection.Range, 1, 2)
'+++++++++++++++++++++++++++++++++++++++++++++
oTable.AutoFitBehavior (wdAutoFitFixed)
oTable.Rows.Height = CentimetersToPoints(7)
oTable.Range.Cells.VerticalAlignment = wdCellAlignVerticalCenter
'++++++++++++++++++++++++++++++++++++++++++++++
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
For i = 1 To .SelectedItems.Count
If i Mod 2 = 0 Then
iRow = i / 2
iCol = 2
Else
iRow = (i + 1) / 2
iCol = 1
End If
Set rngCell = oTable.Cell(iRow, iCol).Range
rngCell.InlineShapes.AddPicture FileName:= _
.SelectedItems(i), _
LinkToFile:=False, _
SaveWithDocument:=True, _
Range:=rngCell
rngCell.ParagraphFormat.Alignment = wdAlignParagraphCenter
'here is the new paragraph with the file name
rngCell.InsertBefore .SelectedItems(i) & vbCr
'now do whatever formatting you want to do here.
'just put in a couple of samples, if this is the kind of thing you want
With rngCell.Paragraphs.First
.KeepWithNext = True
.Alignment = wdAlignParagraphLeft
.Range.Font.Bold = True
.Range.Font.Underline = wdUnderlineSingle
End With
If i < .SelectedItems.Count And i Mod 2 = 0 Then
oTable.Rows.Add
End If
Next i
End If
End With
Set fd = Nothing
End Sub

[ricmo]

Yes code was written by others.
I haven't the ability to do so.
As a tweak, could you be so kind as to let me know how to get the caption at the bottom of the picture, without the location link, just the file name?
Again, thank you for your help.

Continued success,
ricmo

[Frosty]

This should take care of that. You'll still need to decide on some of the specific formatting (and whether you want the filename extension, etc). But this should get you pretty close.

Sub InsertMultipleImages()
Dim fd As FileDialog
Dim oTable As Table
Dim iRow As Integer
Dim iCol As Integer
Dim rngCell As Range
Dim i As Long
Dim sNoDoc As String
If Documents.Count = 0 Then
sNoDoc = MsgBox(" " & _
"No document open!" & vbCr & vbCr & _
"Do you wish to create a new document to hold the images?", _
vbYesNo, "Insert Images")
If sNoDoc = vbYes Then
Documents.Add
Else
Exit Sub
End If
End If
'add a 1 row 2 column table to take the images
Set oTable = Selection.Tables.Add(Selection.Range, 1, 2)
'+++++++++++++++++++++++++++++++++++++++++++++
oTable.AutoFitBehavior (wdAutoFitFixed)
oTable.Rows.Height = CentimetersToPoints(7)
oTable.Range.Cells.VerticalAlignment = wdCellAlignVerticalCenter
'++++++++++++++++++++++++++++++++++++++++++++++
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
For i = 1 To .SelectedItems.Count
If i Mod 2 = 0 Then
iRow = i / 2
iCol = 2
Else
iRow = (i + 1) / 2
iCol = 1
End If
Set rngCell = oTable.Cell(iRow, iCol).Range
rngCell.InlineShapes.AddPicture FileName:= _
.SelectedItems(i), _
LinkToFile:=False, _
SaveWithDocument:=True, _
Range:=rngCell

rngCell.ParagraphFormat.Alignment = wdAlignParagraphCenter

'*** NEW CODE BLOCK
'here is the new paragraph with the file name (and path removed)
rngCell.InsertAfter vbCr & Replace(.SelectedItems(i), .InitialFileName, "")
'now do whatever formatting you want to do here.
'just put in a couple of samples, if this is the kind of thing you want
'the graphic paragraph
With rngCell.Paragraphs.First
.KeepWithNext = True
End With
'the title paragraph
With rngCell.Paragraphs.Last
.Alignment = wdAlignParagraphLeft
.Range.Font.Bold = True
.Range.Font.Underline = wdUnderlineSingle
End With
'*** END NEW CODE BLOCK
If i < .SelectedItems.Count And i Mod 2 = 0 Then
oTable.Rows.Add
End If
Next i
End If
End With
Set fd = Nothing
End Sub

[ricmo]

Thanks for the help!

Best,
ricmo