再質問ポイントアップ

PowerPoint の VBA です（Office 2010、2013 で動作確認）。

Option Explicit

'// 対象のフォーマットを指定
'//----------------------------------
Const PIC_FORMAT = "JPG,GIF,BMP"

'//----------------------------------
Const PIC_ORDER_VERTICAL = 1
Const PIC_ORDER_HORIZONTAL = 2
Const PIC_ORDER = PIC_ORDER_VERTICAL

'//----------------------------------
Const 開始位置_横 = 10
Const 開始位置_縦 = 30
Const デフォルト画像幅 = 30
Const 画像間隔_横 = 3
Const 画像間隔_縦 = 3

'//----------------------------------
Const TO_MILL = 3

'//------------------------------------------------------------------------------
Sub 画像を読み込み()
'//------------------------------------------------------------------------------
    Dim picFolder
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = True Then
            picFolder = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With
    
    Dim topPos As Double
    topPos = 開始位置_縦 * TO_MILL
    
    Dim LeftPos As Double
    LeftPos = 開始位置_横 * TO_MILL
    
    Dim pw As Double
    pw = InputBox("画像の幅を入力してください", "画像幅", デフォルト画像幅)
    If IsNumeric(pw) = False Then Exit Sub
    Dim picWidth As Double
    picWidth = pw * TO_MILL
    
    Dim picMarginX As Double
    picMarginX = 画像間隔_横 * TO_MILL
    
    Dim picMarginY As Double
    picMarginY = 画像間隔_縦 * TO_MILL
    
    Dim currentSlide As Slide
    Set currentSlide = ActiveWindow.Selection.SlideRange(1)
    
    Dim picList As Object
    Set picList = CreateObject("System.Collections.SortedList")

    Dim objFso As Object
    Set objFso = CreateObject("Scripting.FileSystemObject")
    
    Dim file
    Dim ph As Double
    For Each file In objFso.GetFolder(picFolder).Files
        If InStr(PIC_FORMAT, UCase(objFso.GetExtensionName(file.Name))) > 0 Then
            ph = getPicHight(file.Path, picWidth)
            Do While picList.Contains(ph) = True
                ph = ph + 10 ^ -5
            Loop
            picList.Add ph, file.Path
        End If
    Next
    
    Dim px As Double
    px = LeftPos
    Dim py As Double
    py = topPos
    
    Dim dy As Double
    dy = picList.GetKey(picList.Count - 1)
    
    Dim picIndex As Long
    For picIndex = picList.Count - 1 To 0 Step -1
        If (px + picWidth) > ActivePresentation.PageSetup.SlideWidth Then Exit For
        If (py + picList.GetKey(picIndex)) > ActivePresentation.PageSetup.SlideHeight Then Exit For
        AddPicLink picList.GetByIndex(picIndex), currentSlide, px, py, picWidth, picList.GetKey(picIndex)
        
        If picIndex = 0 Then Exit For
        Select Case PIC_ORDER
        Case PIC_ORDER_VERTICAL
            py = py + picMarginY + picList.GetKey(picIndex)
            If (py + picList.GetKey(picIndex - 1)) > ActivePresentation.PageSetup.SlideHeight Then
                px = px + picMarginX + picWidth
                py = topPos
            End If
        Case PIC_ORDER_HORIZONTAL
            px = px + picMarginX + picWidth
            If (px + picMarginX + picWidth) > ActivePresentation.PageSetup.SlideWidth Then
                px = LeftPos
                py = py + dy + picMarginY
                dy = picList.GetKey(picIndex - 1)
            End If
        End Select
    Next

    If picIndex > 0 Then
        MsgBox "画像が現在のスライドにおさまりません"
        RemoveAllPics currentSlide
    End If
End Sub

'//------------------------------------------------------------------------------
Sub AddPicLink(filePath As String, currentSlide As Slide, x, y, cwidth, cheight)
'//------------------------------------------------------------------------------
    currentSlide.Shapes.AddPicture _
        FileName:=filePath, LinkToFile:=True, SaveWithDocument:=False, _
        Left:=x, Top:=y, width:=cwidth, Height:=cheight
End Sub

'//------------------------------------------------------------------------------
Sub RemoveAllPics(currentSlide)
'//------------------------------------------------------------------------------
    Dim noPic As Boolean
    Dim sh
    Do While noPic = False
        noPic = True
        For Each sh In currentSlide.Shapes
            If sh.Type = msoLinkedPicture Then
                sh.Delete
                noPic = False
            End If
        Next
    Loop
End Sub

'//------------------------------------------------------------------------------
Function getPicHight(filePath As String, width As Double) As Double
'//------------------------------------------------------------------------------
    Dim p As Object
    Set p = LoadPicture(filePath)
    getPicHight = width / p.width * p.Height
End Function