Macro to insert all photos in a folder into a single word document

[suet]

Hi

I am looking for a macro that will enable me to select all images in a folder and then insert them into a word document.

I need to be able to specify how many rows and columns are needed.

Also the size of the image - eg: 5cm or 10 cm..etc.

The header needs to allow the user to insert the project title on the left - maybe with a text box prompt.
The header also needs a fixed logo/image on the right everytime the macro is run.

The footer needs to in auto insert the page number in the middle aswell as the current date on the right.

I have got the following code so far:

Sub AddPics()

Application.ScreenUpdating = False

Dim 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

On Error Resume Next

With ActiveDocument

.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 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

ColWdth = TblWdth / NumCols

End With

With oTbl

.AutoFitBehavior (wdAutoFitFixed)

.TopPadding = 0

.BottomPadding = 0

.LeftPadding = 0

.RightPadding = 0

.Spacing = 0

.Columns.Width = ColWdth

.Borders.Enable = True

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

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

'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 = Hght

.HeightRule = wdRowHeightExactly

.Range.Style = "TblPic"

.Cells.VerticalAlignment = wdCellAlignVerticalCenter

End With

With .Rows(x + 1)

.Height = CentimetersToPoints(0.5)

.HeightRule = wdRowHeightExactly

.Range.Style = "Caption"

End With

End With

End Sub

Any help would be greatly appreciated in how to do the following:

Insert the headers
Insert the footers
Specify row/columns


Thanking you in advance.

Kind Regards
Sue

 

[Macropod]

As well you know (see Write Macro to auto insert all images in a folder), the macro is sourced from: Microsoft Office Forums - View Single Post - [Solved] 4 digital images on 1 page, where you will find instructions for setting the size without the need for the prompts.

The rest of your requirements don't require a macro - all they require is for someone to create a document template with the appropriate header & footer content and layout. It's hardly worthwhile writing a macro for someone to insert some text in the page header when that is quite simply done without one.