The code for that is quite different:
Code:
Sub AddPicsNoCaption()
Application.ScreenUpdating = False
Dim Stl As Style, i As Long, j As Long, c As Long, r As Long, NumCols As Long, iShp As InlineShape
Dim oTbl As Table, TblWdth As Single, StrTxt As String, RwHght As Single, ColWdth As Single
On Error GoTo ErrExit
NumCols = CLng(InputBox("How Many Columns per Row?"))
RwHght = CentimetersToPoints(CSng(InputBox("What max height for the pictures, in Centimeters (e.g. 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
'Create a paragraph Style with 0 space before/after & centre-aligned
With ActiveDocument
On Error Resume Next
Set Stl = .Styles("TblPic")
If Stl Is Nothing Then Set Stl = .Styles.Add(Name:="TblPic", Type:=wdStyleTypeParagraph)
On Error GoTo 0
With .Styles("TblPic").ParagraphFormat
.Alignment = wdAlignParagraphCenter
.KeepWithNext = True
.SpaceAfter = 0
.SpaceBefore = 0
End With
End With
'Add a 1-row by NumCols-column table to take the images
Set oTbl = Selection.Tables.Add(Range:=Selection.Range, NumRows:=1, NumColumns:=NumCols)
With ActiveDocument.PageSetup
TblWdth = .PageWidth - .LeftMargin - .RightMargin - .Gutter
ColWdth = TblWdth / NumCols
End With
With oTbl
.AutoFitBehavior (wdAutoFitFixed)
.TopPadding = 0
.BottomPadding = 0
.LeftPadding = 0
.RightPadding = 0
.Spacing = 0
.Columns.Width = ColWdth
.Rows.Height = RwHght
.Rows.HeightRule = wdRowHeightExactly
.Range.Style = "TblPic"
.Range.Cells.VerticalAlignment = wdCellAlignVerticalCenter
.Borders.Enable = True
End With
For i = 1 To .SelectedItems.Count Step NumCols
r = ((i - 1) / NumCols + 1) * 2 - 1
For c = 1 To NumCols
j = j + 1
'Insert the Picture
Set iShp = ActiveDocument.InlineShapes.AddPicture( _
FileName:=.SelectedItems(j), LinkToFile:=False, _
SaveWithDocument:=True, Range:=oTbl.Cell(r, c).Range)
With iShp
.LockAspectRatio = True
If (.Width < ColWdth) And (.Height < RwHght) Then
.Width = ColWdth
If .Height > RwHght Then .Height = RwHght
End If
End With
If j = .SelectedItems.Count Then Exit For
Next
'Add extra rows as needed
If j < .SelectedItems.Count Then
oTbl.Rows.Add
End If
Next
Else
End If
End With
ErrExit:
Application.ScreenUpdating = True
End Sub