Macro to make image fit to slide exactly in PowerPoint

AllekieF · #1 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 · #2 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

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