Inserting Multiple Pictures - Works, but need help tweaking

[n0m4d]

This is my first post here and I'm just starting to dig into VBA macros with Word. I'm working on a template that would allow anyone in my office to insert a large quantity of pictures to make a report. I found several examples of code online and one in particular is working pretty good for me. There are a few things that I'm trying to get cleaned up with it and I was hoping for some advice here.

Code is posted at the bottom (if it's your code, thanks!)

First thing I have been trying to figure out is how I can get it to run automatically the first time the .dotm is used to start a new document. This may not even be possible. I tried this but it doesn't run the macro automatically:

21453

The other thing I am trying to figure out is how to fine tune the alignment of the photos/captions by centering the entire table.

The last thing I'm trying to figure out is how to have a blank cell above the second photo so that I have a space between the first photo's caption and the second photo.

Hopefully I'm not asking too many questions here and thanks in advance.


Option Explicit

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 = 1
'NumCols = CLng(InputBox("How Many Columns per Row?"))
RwHght = 9.1
'RwHght = 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
'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:="Picture"
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:="Picture", 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 = CentimetersToPoints(Hght)
.HeightRule = wdRowHeightExactly
.Range.Style = "Normal"
End With
With .Rows(x + 1)
.Height = CentimetersToPoints(0.5)
.HeightRule = wdRowHeightExactly
.Range.Style = "Normal"
End With
End With
End Sub

[Kilroy]

I believe this might work for you.



right click on the template and press open (will not work if you just double click to open.)
Launch the Visual Basic Editor (VBE) by pressing [Alt]+F11.
In the Project Explorer, double-click ThisDocument.
In the resulting module, put in your picture code.
Click Save and then close the VBE.
Save and close the template.
Double click the template to open and it should work.

[macropod]

First thing I have been trying to figure out is how I can get it to run automatically the first time the .dotm is used to start a new document. This may not even be possible. I tried this but it doesn't run the macro automatically:
Simply paste the code referred to in your post into your template's 'ThisDocument' code module, then change:
Sub AddPics()
to:
Private Sub Document_New()


The other thing I am trying to figure out is how to fine tune the alignment of the photos/captions by centering the entire table.

After:
.Columns.Width = TblWdth / NumCols
insert:
.Rows.Alignment = wdAlignRowCenter

The last thing I'm trying to figure out is how to have a blank cell above the second photo so that I have a space between the first photo's caption and the second photo.
Rather than doing that, which would require a code re-write, you might change:
.Height = CentimetersToPoints(0.5)
to, say:
.Height = CentimetersToPoints(1)
.Cells.VerticalAlignment = wdCellAlignVerticalTop

[n0m4d]

I believe this might work for you.



right click on the template and press open (will not work if you just double click to open.)
Launch the Visual Basic Editor (VBE) by pressing [Alt]+F11.
In the Project Explorer, double-click ThisDocument.
In the resulting module, put in your picture code.
Click Save and then close the VBE.
Save and close the template.
Double click the template to open and it should work.



Thanks for the steps. I followed them as exact as possible except for step 4, that code is already in the module, that's how I got the picture, but its not kicking off after step 7. In step 4 do I also need to specify what I want to run when creating a new doc with this template? My macro is called "AddPics".
21456

[n0m4d]

Thanks macropod, I'll give those steps a try.

[n0m4d]

These suggestions did the trick. Thanks Macropod!