Macro to make image fit to slide exactly in PowerPoint

RobertDany · #1 10-12-2023, 05:35 AM

Hi,
I want a macro to make an image fit to slide exactly like this:
36.png

Thanks

AllekieF · #2 10-12-2023, 07:07 AM

Why do you need a macro for that?
Go to the master slides view, create a new layout and place an image placeholder which fills the entire slide. Go back to the normal view, click on the placeholder and select the image you need (or paste the image). This will automatically crop and scale the image to the right size.

RobertDany · #3 10-12-2023, 07:33 AM

Quote:

Originally Posted by AllekieF

Why do you need a macro for that?
Go to the master slides view, create a new layout and place an image placeholder which fills the entire slide. Go back to the normal view, click on the placeholder and select the image you need (or paste the image). This will automatically crop and scale the image to the right size.

Thank so much
It's ok for copy paste image or new file based on slide master that I made it
but what for a file which already contain images (copy paste will maintain orginal size, changing layout has no effect), so a macro will play a role here
Any suggestion?

AllekieF · #4 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

RobertDany · #5 10-13-2023, 03:09 AM

Quote:

Originally Posted by AllekieF

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.

Hope this helps.

Dear AllekieF
Thank you so much for your time and efforts
In most times, I use copy paste image from the internet, so there is no placeholders in most times
Thanks for your code, but it works for one image, then when I apply it to the second or third image, this message appears:
37.png

Dear, To clarify my need,
I want to apply this code to selected image only, but not on all slides (just selected image only on the current slide).

Thanks

AllekieF · #6 10-13-2023, 03:21 AM

Modified the code a bit. Should work, but doesn't check for correct selection type.

Code:

Option Explicit

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

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

If ActiveWindow.Selection.Type = ppSelectionShapes Then
    Application.CommandBars.ExecuteMso ("PictureResetAndSize")
    With ActiveWindow.Selection.ShapeRange
        .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
End Sub

RobertDany · #7 10-13-2023, 04:04 AM

Quote:

Originally Posted by AllekieF

Modified the code a bit. Should work, but doesn't check for correct selection type.

It works perfectly

That's what I want
Thanks so much

I also googled and found this code, and also works perfectly

Code:

Sub AlignAndStretchImage()
' VBA macro to align an image in the middle and center of the slide

    Dim shp As Shape
    Set shp = ActiveWindow.Selection.ShapeRange(1)
    
        ' Set the shape's size to match the slide's size
    shp.LockAspectRatio = msoFalse
    shp.Width = ActivePresentation.PageSetup.SlideWidth
    shp.Height = ActivePresentation.PageSetup.SlideHeight
    
    ' Set the shape's position to the center of the slide
    shp.Left = (ActivePresentation.PageSetup.SlideWidth - shp.Width) / 2
    shp.Top = (ActivePresentation.PageSetup.SlideHeight - shp.Height) / 2
    

End Sub

Best Regards

AllekieF · #8 10-13-2023, 04:56 AM

The other code does work. Only downside is that it doesn't scale evenly, i.e. the aspect ratio of the image is not respected. This can result in distorted images.

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
PowerPoint Slide Image Size / Position	revocats10	PowerPoint	1	01-23-2021 02:26 AM
VBS script to make PowerPoint's default slide size to 16:9 from 4:3.	jr13	PowerPoint	1	03-21-2015 04:34 AM
How to make specific slide be unlike the master slide	Konnie	PowerPoint	4	11-03-2014 05:16 AM
Saving as ( PowerPoint Macro-Enabled Slide Show )??	delete123	PowerPoint	2	04-10-2013 05:38 AM
URGENT!!! Powerpoint Image Formatting and Positioning Macro	mertulufi	PowerPoint	5	12-20-2011 10:14 AM