Okay, sorry Jim, you were too slow. =)
I now have the macro to populate slides with images (see below). It
works pretty well, but it has a few mildly painful limitations: 1) it
requires images to be square, 2) it requires the user to edit the
macro for each layout, 3) PowerPoint doesn't seem to want to read
files off nfs-mounted disks.
If anyone has any suggestions on how to rectify these, that'd be
great.
- Bryan
-------------------------
Sub showBounds()
' This routine will help you determine the values for the insertPics
routine
' Before running this, draw a rectangle as big as the area you want
your pictures
' to fill, select it, then run this macro.
myTop = ActiveWindow.Selection.ShapeRange(1).Top
myLeft = ActiveWindow.Selection.ShapeRange(1).Left
myBottom = myTop + ActiveWindow.Selection.ShapeRange(1).Height
myRight = myLeft + ActiveWindow.Selection.ShapeRange(1).Width
MsgBox "Your box is: top " & myTop & ", left: " & myLeft & ", bottom:
" & myBottom & ", myRight: " & myRight
End Sub
Sub insertPics()
' Inserts a folder full of .png files into PowerPoint
' NOTE: Assumes square images
' user edits these
myPath = "Ralph:Users:bh
esktop
ngs"
myCols = 5
myRows = 4
myTop = 57.5
myLeft = 25.625
myBottom = 529.25
myRight = 687.375
myPad = 4 ' minimum pad between images
' ------------------------
Dim oPicture As Shape
Dim FullPath As String
imWidth = (myRight - myLeft - ((myCols - 1) * myPad)) / myCols
imHeight = (myBottom - myTop - ((myRows - 1) * myPad)) / myRows
If imWidth > imHeight Then
imSide = imHeight
Else
imSide = imWidth
End If
myHPad = ((myRight - myLeft) - (myCols * imSide)) / (myCols - 1)
myVPad = ((myBottom - myTop) - (myRows * imSide)) / (myRows - 1)
ActiveWindow.ViewType = ppViewSlide
With Application.FileFind
.SearchPath = myPath
.SearchSubFolders = True
.FileName = ".png"
.FileType = msoFileTypeAllFiles
If .Execute() > 0 Then
curRow = 1
curCol = 1
curSlide = ActiveWindow.Selection.SlideRange.SlideNumber
FileList = ""
For i = 1 To .FoundFiles.Count
FullPath = .FoundFiles(i)
FileList = FileList & "Slide " & curSlide & " - " &
FullPath & Chr(13)
Set oPicture =
ActiveWindow.Selection.SlideRange.Shapes.AddPicture _
(FileName:=FullPath, _
LinkToFile:=msoFalse, _
SaveWithDocument:=msoTrue, _
Left:=myLeft + (curCol - 1) * (imSide + myHPad), _
Top:=myTop + (curRow - 1) * (imSide + myVPad), _
Width:=imSide, _
Height:=imSide)
oPicture.ZOrder msoSendToBack
curCol = curCol + 1
If curCol > myCols Then
curCol = 1
curRow = curRow + 1
If curRow > myRows And .FoundFiles.Count > i Then
curSlide = curSlide + 1
ActiveWindow.View.GotoSlide
Index:=ActivePresentation.Slides.Add(Index:=curSlide,
Layout:=ppLayoutBlank).SlideIndex
curRow = 1
End If
End If
Next i
curSlide = curSlide + 1
ActiveWindow.View.GotoSlide
Index:=ActivePresentation.Slides.Add(Index:=curSlide,
Layout:=ppLayoutBlank).SlideIndex
ActiveWindow.Selection.SlideRange.Shapes.AddTextbox _
(msoTextOrientationHorizontal, 57.5, 25.625, 471.75,
667.232).Select
ActiveWindow.Selection.TextRange.Text = FileList
ActiveWindow.Selection.TextRange.Font.Size = 10
Else
MsgBox "There were no files found."
End If
End With
Set oPicture = Nothing
End Sub