Macro to insert images into table

[neoncake]

I am trying to create a Macro for Word, where I can select multiple pictures and insert them into a table, 2 Columns wide, with pictures on the odd rows and their captions on the even rows. I want to resize each picture to 8cm wide, and have no borders on the table.


I have attached images of the end result I am trying to achieve (minus the visible borders).

Any help would be appreciated a lot, cheers.
Below is the closest code I have found to what I want. The code is from the user macropod, on here. :)
26240


Sub AddPics()
Application.ScreenUpdating = False

Dim oTbl As Table, i As Long, j As Long, k As Long, StrTxt As String

'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 2-column table with 7cm columns to take the images
Set oTbl = Selection.Tables.Add(Selection.Range, 2, 2)
With oTbl
.AutoFitBehavior (wdAutoFitFixed)
.Columns.Width = CentimetersToPoints(7)
'Format the rows
Call FormatRows(oTbl, 1)
End With

CaptionLabels.Add Name:="Picture"

For i = 1 To .SelectedItems.Count
j = Int((i + 1) / 2) * 2 - 1
k = (i - 1) Mod 2 + 1
'Add extra rows as needed
If j > oTbl.Rows.Count Then
oTbl.Rows.Add
oTbl.Rows.Add
Call FormatRows(oTbl, j)
End If
'Insert the Picture
ActiveDocument.InlineShapes.AddPicture _
FileName:=.SelectedItems(i), LinkToFile:=False, _
SaveWithDocument:=True, Range:=oTbl.Rows(j).Cells(k).Range
'Get the Image name for the Caption
StrTxt = Split(.SelectedItems(i), "\")(UBound(Split(.SelectedItems(i), "\")))
StrTxt = ": " & Split(StrTxt, ".")(0)
'Insert the Caption on the row below the picture
With oTbl.Rows(j + 1).Cells(k).Range
.InsertBefore vbCr
.Characters.First.InsertCaption _
Label:="Picture", Title:=StrTxt, _
Position:=wdCaptionPositionBelow, ExcludeLabel:=False
.Characters.First = vbNullString
.Characters.Last.Previous = vbNullString
End With
Next
End If
End With
Application.ScreenUpdating = True
End Sub
'
Sub FormatRows(oTbl As Table, x As Long)
With oTbl
With .Rows(x)
.Height = CentimetersToPoints(7)
.HeightRule = wdRowHeightExactly
.Range.Style = "Normal"
End With
With .Rows(x + 1)
.Height = CentimetersToPoints(0.75)
.HeightRule = wdRowHeightExactly
.Range.Style = "Caption"
End With
End With
End Sub

[macropod]

After:
With oTbl
insert:
.Borders.Enable = False


You should also change:
.Columns.Width = CentimetersToPoints(7)
to:
.Columns.Width = CentimetersToPoints(8)


You might also find it useful to change:
.Height = CentimetersToPoints(7)
to something more closely approximating the required picture height. If they're only in landscape format with the typical 3:2 aspect ratio, you might use:
.Height = CentimetersToPoints(5.33)
For pics using a 4:3 ratio, you might use:
.Height = CentimetersToPoints(6)
But, if you have a mix of pics in portrait and landscape orientation, you'd probably want to use:
.Height = CentimetersToPoints(8)

[neoncake]

The table leaves large gaps after every image, how would I remove these?
The images are a mix of landscape and portrait.
Also the text is blue, what could i change to make it black?

Below is an image of the result with the current code.
Cheers for the help Paul.

26241

[macropod]

The table leaves large gaps after every image, how would I remove these?

Did you read what I said in my previous reply about the image heights?


The images are a mix of landscape and portrait.

The images in your post are only in landscape format. If you change the row heights to suit landscape images, your portrait images will be scaled down to suit that height.

Another approach would be to insert:
.Range.Cells.VerticalAlignment = wdCellAlignVerticalCenter
or:

.Range.Cells.VerticalAlignment = wdCellAlignVerticalBottom
after:
With oTbl
to change where the images sit within their cells.


Also the text is blue, what could i change to make it black?By changing the Caption Style.

[neoncake]

Did you read what I said in my previous reply about the image heights?


The images in your post are only in landscape format. If you change the row heights to suit landscape images, your portrait images will be scaled down to suit that height.

Another approach would be to insert:
.Range.Cells.VerticalAlignment = wdCellAlignVerticalCenter
or:

.Range.Cells.VerticalAlignment = wdCellAlignVerticalBottom
after:
With oTbl
to change where the images sit within their cells.

By changing the Caption Style.

Ahh i misread, thanks. I've got a few portrait photos so i'll try stick with 8cm for now.

Thankyou for your help, I really appreciate it!

[gmayor]

See also https://www.gmayor.com/photo_gallery_template.html