Sub ImportPicturesIntoPowerpointPresentation()

    'this code imports a folder of pictures into a Powerpoint presentation
    'taken from http://www.ajronline.org/content/182/6/1591.full.pdf+html
    'prepared by: Chris Sistrom and Janice Honeyman - Buck, 2004.
    'slightly adapted by: Gjuro Kladaric, 2012.
    
    Dim File_Cnt, Sld_Cnt, Sld_Pos As Long
    Dim Source_Dir, File_Name, Path_Complete, Ext_3, Ext_4 As String
    Dim sldNewSlide As Slide
    Dim shpPicture As Shape
    Dim tmpWidth, tmpHeight, W_H_pic, W_H_sld, lngSldHeight, lngSldWidth As Double
    File_Cnt = 0
    Sld_Cnt = 0
    
    Source_Dir = InputBox("Location of images, End with / (: for Macintosh)", "Image Directory")
    If Right(Source_Dir, 1) <> "\" Then Source_Dir = Source_Dir & "\"
    If Len(Source_Dir) = 0 Or IsNull(Source_Dir) Then GoTo No_Input_Exit
    On Error GoTo No_Input_Exit
    
    File_Name = Dir(Source_Dir, vbNormal)
    While Len(File_Name) <> 0
        File_Cnt = File_Cnt + 1
        Ext_3 = UCase(Right(File_Name, 3))
        Ext_4 = UCase(Right(File_Name, 4))
        If Ext_3 = "TIF" Or Ext_3 = "GIF" Or Ext_3 = "JPG" Or Ext_3 = "PNG" _
            Or Ext_4 = "JPEG" Or Ext_3 = "PCX" Or Ext_3 = "BMP" Then
            Sld_Cnt = Sld_Cnt + 1
            Path_Complete = Source_Dir & File_Name
            Sld_Pos = ActivePresentation.Slides.Count
            Set sldNewSlide = ActivePresentation.Slides.Add(Index:=Sld_Pos + 1, _
                Layout:=ppLayoutBlank)
            Set shpPicture = sldNewSlide.Shapes.AddPicture(FileName:=Path_Complete, _
                LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, _
                Left:=0, Top:=0, Width:=100, Height:=100)
            shpPicture.LockAspectRatio = True
            shpPicture.ScaleHeight 1#, msoCTrue
            shpPicture.ScaleWidth 1#, msoCTrue
            lngSldWidth = ActivePresentation.PageSetup.SlideWidth
            lngSldHeight = ActivePresentation.PageSetup.SlideHeight
            tmpWidth = shpPicture.Width
            tmpHeight = shpPicture.Height
            W_H_pic = tmpWidth / tmpHeight
            W_H_sld = lngSldWidth / lngSldHeight
            If W_H_pic >= W_H_sld Then
                shpPicture.Width = lngSldWidth
            Else
                shpPicture.Height = lngSldHeight
            End If
            tmpWidth = shpPicture.Width
            tmpHeight = shpPicture.Height
            shpPicture.Top = (lngSldHeight - tmpHeight) / 2
            shpPicture.Left = (lngSldWidth - tmpWidth) / 2
        End If
        File_Name = Dir()
    Wend

No_Input_Exit:
    
    MsgBox "Input Directory=" & Source_Dir & Chr(13) & Chr(10) & _
    "Total Files=" & File_Cnt & "Slides Added=" & Sld_Cnt, vbOKOnly, "Results"
    
End Sub