The macro creates a two column table with fixed width cells, each half the
distance between the current margins. Images are inserted in line and as
images will adapt to the cell width, any images (larger than the width of
the cells) inserted into those cells will fill the available space. Whether
they are centred or left aligned should be immaterial unless the images are
smaller than the cells, but I have added the commands to centre align
The number of rows that will fit on the page will depend on whether the
pictures are portrait or landscape and the size of the page margins. If they
are all the same orientation, you can apply a suitable a fixed row height
where indicated with +++++++
I have revised the quoted macro below:
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
--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP
My web site
www.gmayor.com
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>