'-----------------------------------------------------------------
' 画像を中央配置してトリミング（表示中のスライドのみ）
' ・1ページ目は実行しない
' ・画像が2枚以上のスライドは実行しない
'-----------------------------------------------------------------

Sub 画像を中央配置してトリミング_表示中()

    Dim prs As Presentation
    Dim sld As Slide
    Set prs = ActivePresentation
    Set sld = ActiveWindow.View.Slide

    If sld.SlideIndex = 1 Then
        MsgBox "1ページ目は対象外です。", vbInformation
        Exit Sub
    End If

    Dim result As String
    result = 画像処理(prs, sld)

    If result = "skip" Then
        MsgBox "画像が2枚以上のため実行しませんでした。", vbInformation, "スキップ"
    ElseIf result = "none" Then
        MsgBox "画像が見つかりませんでした。", vbInformation, "スキップ"
    Else
        MsgBox "処理しました。", vbInformation, "完了"
    End If

End Sub

'-----------------------------------------------------------------
' 画像を中央配置してトリミング（1ページ目以外の全ページ）
' ・画像が2枚以上のスライドはスキップ
'-----------------------------------------------------------------

Sub 画像を中央配置してトリミング_全ページ()

    Dim prs  As Presentation
    Dim sld  As Slide
    Dim cnt  As Long
    Dim skip As Long

    Set prs = ActivePresentation
    cnt  = 0
    skip = 0

    Dim i As Long
    For i = 2 To prs.Slides.Count
        Set sld = prs.Slides(i)
        Dim result As String
        result = 画像処理(prs, sld)
        If result = "ok"   Then cnt  = cnt  + 1
        If result = "skip" Then skip = skip + 1
    Next i

    MsgBox cnt & " ページ処理しました。" & vbCrLf & _
           skip & " ページをスキップしました（画像2枚以上）。", vbInformation, "完了"

End Sub

'-----------------------------------------------------------------
' 共通処理：1スライドの画像を中央配置・拡大縮小・トリミング
' 戻り値: "ok" / "skip"（画像2枚以上）/ "none"（画像なし）
'-----------------------------------------------------------------

Private Function 画像処理(prs As Presentation, sld As Slide) As String

    Dim shp As Shape
    Dim j   As Long

    ' 画像枚数カウント
    Dim imgCount As Long
    imgCount = 0
    Dim targetShp As Shape
    For j = 1 To sld.Shapes.Count
        Set shp = sld.Shapes(j)
        If shp.Type = msoPicture Or shp.Type = msoLinkedPicture Then
            imgCount = imgCount + 1
            Set targetShp = shp
        End If
    Next j

    If imgCount = 0 Then
        画像処理 = "none"
        Exit Function
    End If

    If imgCount >= 2 Then
        画像処理 = "skip"
        Exit Function
    End If

    ' スライドサイズ
    Dim sldW As Single
    Dim sldH As Single
    sldW = prs.PageSetup.SlideWidth
    sldH = prs.PageSetup.SlideHeight
    Dim targetRatio As Single
    targetRatio = sldW / sldH

    Set shp = targetShp

    ' トリミングリセット
    With shp.PictureFormat
        .CropTop    = 0
        .CropBottom = 0
        .CropLeft   = 0
        .CropRight  = 0
    End With

    ' 元サイズ
    Dim imgW As Single
    Dim imgH As Single
    imgW = shp.Width
    imgH = shp.Height
    Dim imgRatio As Single
    imgRatio = imgW / imgH

    ' スライドに収まる最大サイズ
    Dim newW As Single
    Dim newH As Single
    If imgRatio > targetRatio Then
        newW = sldW
        newH = sldW / imgRatio
    Else
        newH = sldH
        newW = sldH * imgRatio
    End If

    shp.Width  = newW
    shp.Height = newH

    ' 中央配置
    shp.Left = (sldW - newW) / 2
    shp.Top  = (sldH - newH) / 2

    ' 中央基準で16:9トリミング
    Dim cropW As Single
    Dim cropH As Single
    If imgRatio > targetRatio Then
        cropH = newH
        cropW = cropH * targetRatio
    Else
        cropW = newW
        cropH = cropW / targetRatio
    End If

    Dim cropLR As Single
    Dim cropTB As Single
    cropLR = (newW - cropW) / 2
    cropTB = (newH - cropH) / 2

    With shp.PictureFormat
        .CropLeft   = cropLR
        .CropRight  = cropLR
        .CropTop    = cropTB
        .CropBottom = cropTB
    End With

    ' スライドいっぱいに拡大
    shp.Width  = sldW
    shp.Height = sldH
    shp.Left   = 0
    shp.Top    = 0

    画像処理 = "ok"

End Function

'-----------------------------------------------------------------
' 画像をトリミングなしで表示最大化（表示中のスライドのみ）
'-----------------------------------------------------------------

Sub 画像を最大化_表示中()

    Dim prs As Presentation
    Dim sld As Slide
    Set prs = ActivePresentation
    Set sld = ActiveWindow.View.Slide

    If sld.SlideIndex = 1 Then
        MsgBox "1ページ目は対象外です。", vbInformation
        Exit Sub
    End If

    Dim result As String
    result = 画像最大化処理(prs, sld)

    If result = "skip" Then
        MsgBox "画像が2枚以上のため実行しませんでした。", vbInformation, "スキップ"
    ElseIf result = "none" Then
        MsgBox "画像が見つかりませんでした。", vbInformation, "スキップ"
    Else
        MsgBox "処理しました。", vbInformation, "完了"
    End If

End Sub

'-----------------------------------------------------------------
' 画像をトリミングなしで表示最大化（1ページ目以外の全ページ）
'-----------------------------------------------------------------

Sub 画像を最大化_全ページ()

    Dim prs  As Presentation
    Dim sld  As Slide
    Dim cnt  As Long
    Dim skip As Long

    Set prs = ActivePresentation
    cnt  = 0
    skip = 0

    Dim i As Long
    For i = 2 To prs.Slides.Count
        Set sld = prs.Slides(i)
        Dim result As String
        result = 画像最大化処理(prs, sld)
        If result = "ok"   Then cnt  = cnt  + 1
        If result = "skip" Then skip = skip + 1
    Next i

    MsgBox cnt & " ページ処理しました。" & vbCrLf & _
           skip & " ページをスキップしました（画像2枚以上）。", vbInformation, "完了"

End Sub

'-----------------------------------------------------------------
' 共通処理：トリミングなし・アスペクト比維持・中央最大化
' 戻り値: "ok" / "skip"（画像2枚以上）/ "none"（画像なし）
'-----------------------------------------------------------------

Private Function 画像最大化処理(prs As Presentation, sld As Slide) As String

    Dim shp As Shape
    Dim j   As Long

    ' 画像枚数カウント
    Dim imgCount As Long
    imgCount = 0
    Dim targetShp As Shape
    For j = 1 To sld.Shapes.Count
        Set shp = sld.Shapes(j)
        If shp.Type = msoPicture Or shp.Type = msoLinkedPicture Then
            imgCount = imgCount + 1
            Set targetShp = shp
        End If
    Next j

    If imgCount = 0 Then
        画像最大化処理 = "none"
        Exit Function
    End If

    If imgCount >= 2 Then
        画像最大化処理 = "skip"
        Exit Function
    End If

    ' スライドサイズ
    Dim sldW As Single
    Dim sldH As Single
    sldW = prs.PageSetup.SlideWidth
    sldH = prs.PageSetup.SlideHeight
    Dim targetRatio As Single
    targetRatio = sldW / sldH

    Set shp = targetShp

    ' トリミングリセット
    With shp.PictureFormat
        .CropTop    = 0
        .CropBottom = 0
        .CropLeft   = 0
        .CropRight  = 0
    End With

    ' 元サイズ・比率
    Dim imgW As Single
    Dim imgH As Single
    imgW = shp.Width
    imgH = shp.Height
    Dim imgRatio As Single
    imgRatio = imgW / imgH

    ' スライドに収まる最大サイズ（アスペクト比維持・トリミングなし）
    Dim newW As Single
    Dim newH As Single
    If imgRatio > targetRatio Then
        ' 横長画像 → 幅をスライド幅に合わせる
        newW = sldW
        newH = sldW / imgRatio
    Else
        ' 縦長画像 → 高さをスライド高さに合わせる
        newH = sldH
        newW = sldH * imgRatio
    End If

    shp.Width  = newW
    shp.Height = newH

    ' スライド中央に配置
    shp.Left = (sldW - newW) / 2
    shp.Top  = (sldH - newH) / 2

    画像最大化処理 = "ok"

End Function