Microsoft Office Forums - View Single Post - Macro to make image fit to slide exactly in PowerPoint

AllekieF · 10-13-2023, 02:37 AM

If the image is placed in a placeholder, modifying the layout should have an immediate effect on all pictures. If this is not done, then try the code below.

It identifies each image on all slides. resets it to the original size and crop settings (you need this as the crop size is a function of the original picture size), checks the dimensions related to the page size and resizes for this, then crops the image to fit the page and places it on the correct position.

Hope this helps.

Code:

Option Explicit

Sub reziseImage()
Dim J As Integer, k As Integer, m As Integer
Dim pageHeight As Integer, pageWidth As Integer
Dim cropSize As Double

pageHeight = ActivePresentation.PageSetup.SlideHeight
pageWidth = ActivePresentation.PageSetup.SlideWidth

For J = 1 To ActivePresentation.Slides.Count
    For k = 1 To ActivePresentation.Slides(J).Shapes.Count
        If ActivePresentation.Slides(J).Shapes(k).Type = msoPicture Then
            ActivePresentation.Slides(J).Shapes(k).Select
            Application.CommandBars.ExecuteMso ("PictureResetAndSize")
            With ActivePresentation.Slides(J).Shapes(k)
                .LockAspectRatio = True
                If .Height / .Width > pageHeight / pageWidth Then
                    cropSize = (pageWidth / .Width * .Height - pageHeight) / (pageWidth / .Width) / 2
                    .Width = pageWidth
                    .PictureFormat.CropTop = cropSize
                    .PictureFormat.CropBottom = cropSize
                Else
                    cropSize = (pageHeight / .Height * .Width - pageWidth) / (pageHeight / .Height) / 2
                    .Height = pageHeight
                    .PictureFormat.CropLeft = cropSize
                    .PictureFormat.CropRight = cropSize
                End If
                .Left = 0
                .Top = 0
            End With
        End If

    Next k
Next J

End Sub