Supercharge your PowerPoint productivity with
Supercharge your PPT Productivity with PPTools - Click here to learn more.

Proud member of

PPTools

Image Export converts PowerPoint slides to high-quality images.

PPT2HTML exports HTML even from PowerPoint 2010 and 2013, gives you full control of PowerPoint HTML output, helps meet Section 508 accessibility requirements

Merge Excel data into PowerPoint presentations to create certificates, awards presentations, personalized presentations and more

Resize your presentations quickly and without distortion

Language Selector switches the text in your presentation from one language to another

FixLinks prevents broken links when you distribute PowerPoint presentations

Shape Styles brings styles to PowerPoint. Apply complex formatting with a single click.

Batch Insert a folder full of pictures, one per slide

This is intended as sample code for quick one-time uses or as an example that'll help you get started writing your own macros. If you're looking for a reliable production tool for batch importing images into slides, please see BATCH IMPORT images into PowerPoint

Note: This code only works in Windows versions of PowerPoint, not Mac.

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, _
    Height:=-1)
    ' width/height of -1 tells PPT to import the image at its "natural" size

' Optionally, make it fill the slide - even if that means changing the proportions of the picture
' To do that, uncomment the following:
'  With oPic
'      .LockAspectRatio = msoFalse
'      .height = ActivePresentation.PageSetup.Slideheight
'      .width = ActivePresentation.PageSetup. Slidewidth
'  End With

' Or (with thanks to David Marcovitz) make the picture as big as possible on the slide
' without changing the proportions
' Leave the above commented out, uncomment this instead:
'   With oPic
'     If 3 * .width > 4 * .height Then
'         .width = ActivePresentation.PageSetup.Slidewidth
'         .Top = 0.5 * (ActivePresentation.PageSetup.Slideheight - .height)
'     Else
'       .height = ActivePresentation.PageSetup.Slideheight
'         .Left = 0.5 * (ActivePresentation.PageSetup.Slidewidth - .width)
'     End If
'   End With

' Optionally, add the full path of the picture to the image as a tag:
'With oPic
'  .Tags.Add "OriginalPath", strPath & strTemp
'End With

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

End Sub

Another approach for multiple pictures on a slide

Sub ImportABunch()

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

Dim lCurrentRound As Long
lCurrentRound = 1

' Edit these to suit:
'strPath = "C:\Users\dklaz\Desktop\Prep for China\Factory Pictures\Best Beteck\"
strPath = "P:\photos\MakePrints_2008_Japan\"
strFileSpec = "*.jpg"

strTemp = Dir(strPath & strFileSpec)

Do While strTemp <> ""

    If lCurrentRound = 1 Then   ' add a new slide
        Set oSld = ActivePresentation.Slides.Add(ActivePresentation.Slides.Count + 1, ppLayoutCustom)
    End If
            Set oPic = oSld.Shapes.AddPicture(FileName:=strPath & strTemp, _
            LinkToFile:=msoFalse, _
            SaveWithDocument:=msoTrue, _
            Left:=0, _
            Top:=0, _
            Width:=-1, _
            Height:=-1)

        ' Edit the Left/Top values below if you want to place
        ' the images in specific locations
'        Select Case lCurrentRound
'            Case 1
'                oPic.Left = 0
'                oPic.Top = 0
'
'            Case 2
'                oPic.Left = 100
'                oPic.Top = 100
'
'            Case 3
'                oPic.Left = 200
'                oPic.Top = 200
'
'            Case 4
'                oPic.Left = 300
'                oPic.Top = 300
'        End Select

        '' Or try something like this to assign each
        '' image's top/left to a quadrant
        Select Case lCurrentRound
            Case 1
                oPic.Left = 0
                oPic.Top = 0

            Case 2
                oPic.Left = ActivePresentation.PageSetup.SlideWidth / 2
                oPic.Top = 0

            Case 3
                oPic.Left = 0
                oPic.Top = ActivePresentation.PageSetup.SlideHeight / 2

            Case 4
                oPic.Left = ActivePresentation.PageSetup.SlideWidth / 2
                oPic.Top = ActivePresentation.PageSetup.SlideHeight / 2
        End Select

    If lCurrentRound = 4 Then
        lCurrentRound = 1
    Else
        lCurrentRound = lCurrentRound + 1
    End If

    strTemp = Dir

Loop

End Sub

See How do I use VBA code in PowerPoint? to learn how to use this example code.

Search terms:


Did this solve your problem? If so, please consider supporting the PPT FAQ with a small PayPal donation.
Page copy protected against web site content infringement by Copyscape Contents © 1995 - 2022 Stephen Rindsberg, Rindsberg Photography, Inc. and members of the MS PowerPoint MVP team. You may link to this page but any form of unauthorized reproduction of this page's contents is expressly forbidden.

Supercharge your PPT Productivity with PPTools

content authoring & site maintenance by
Friday, the automatic faq maker (logo)
Friday - The Automatic FAQ Maker

Batch Insert a folder full of pictures, one per slide
http://www.pptfaq.com/FAQ00352_Batch_Insert_a_folder_full_of_pictures-_one_per_slide.htm
Last update 09 January, 2019
Created: