copy pictures from a folder, one per slide

The code below will go to a folder, copy all the pictures and put them on slides in a powerpoint, one picture per slide.

Sub ImportABunch()

Dim strTemp As String
Dim strPath As String
Dim strFileSpec As String
Dim oSld As Slide
Dim oPic As Shape

' Edit these to suit:
strPath = "c:\My Pictures\"
strFileSpec = "*.jpg"

strTemp = Dir(strPath & strFileSpec)

Do While strTemp <> ""
    Set oSld = ActivePresentation.Slides.Add(ActivePresentation.Slides.Count + 1, ppLayoutBlank)
    Set oPic = oSld.Shapes.AddPicture(FileName:=strPath & strTemp, _
    LinkToFile:=msoFalse, _
    SaveWithDocument:=msoTrue, _
    Left:=0, _
    Top:=0, _
    Width:=-1, _
    ' width/height of -1 tells PPT to import the image at its "natural" size

' make the picture as big as possible on the slide
' without changing the proportions
With oPic
If 3 * .width > 4 * .height Then
.width = ActivePresentation.PageSetup.Slidewidth
.Top = 0.5 * (ActivePresentation.PageSetup.Slideheight - .height)
.height = ActivePresentation.PageSetup.Slideheight
.Left = 0.5 * (ActivePresentation.PageSetup.Slidewidth - .width)
End If
End With

    ' Get the next file that meets the spec and go round again
    strTemp = Dir

End Sub

Leave a Reply

Fill in your details below or click an icon to log in: Logo

You are commenting using your account. Log Out /  Change )

Twitter picture

You are commenting using your Twitter account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

Connecting to %s

%d bloggers like this: