Making a Template in Word for Photos

[Andrea]

I need to make a Photo Contact sheet that will incorporate two photos per
page that can be imported in a batch and then a caption added for each photo.
Plus a header at the top. This form will be used repeatedly. I've tried
using the template instructions that I've found but I'm not getting the
option to batch import. It is very important that this be done in Word or
Excel as the rest of the report will be done in Word. Any help would be
greatly appreciated.

 

[Graham Mayor]

Create a new folder and put in it the image files you wish to insert.
Ensure that the folder ONLY contains the images you wish to insert!!!
Create and save a template containing a single table cell of fixed
dimensions suitable to accommodate one of your images, but small enough to
fit two cells to a page.
Change the line
Set oDoc = Documents.Add("d:\Word 2007 Templates\Test1.dotx")
to reflect the path/name of your template (you could use Word 2003 dot
format)
Then run the following macro. Pick the folder with the images and clock OK
to insert all the images and their filenames contained in the selected
folder into the table (new cells of the same size will be created for each
new image).

Sub BatchProcess()
Dim strFileName As String
Dim strPath As String
Dim oDoc As Document
Dim fDialog As FileDialog
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)

With fDialog
.title = "Select folder and click OK"
.AllowMultiSelect = False
.InitialView = msoFileDialogViewList
If .Show <> -1 Then
MsgBox "Cancelled By User", , _
"List Folder Contents"
Exit Sub
End If
strPath = fDialog.SelectedItems.Item(1)
If Right(strPath, 1) <> "\" _
Then strPath = strPath + "\"
End With

If Documents.Count > 0 Then
Documents.Close SaveChanges:=wdPromptToSaveChanges
End If
If Left(strPath, 1) = Chr(34) Then
strPath = Mid(strPath, 2, Len(strPath) - 2)
End If
strFileName = Dir$(strPath & "*.*")
Set oDoc = Documents.Add("d:\Word 2007 Templates\Test1.dotx")

While Len(strFileName) <> 0
oDoc.Tables(1).Cell(oDoc.Tables(1).Rows.Count, 1).Range.Select
Selection.InlineShapes.AddPicture _
FileName:=strFileName, _
LinkToFile:=False, _
SaveWithDocument:=True
With Selection
.Collapse wdCollapseEnd
.TypeParagraph
.TypeText Text:=strPath & strFileName
.MoveRight Unit:=wdCell
End With
strFileName = Dir$()
Wend
oDoc.Tables(1).Cell(oDoc.Tables(1).Rows.Count, 1).Delete
End Sub

http://www.gmayor.com/installing_macro.htm