Skip to content

PowerPoint Changing the Aspect Ratio of Images When Switching Slide Dimensions

As a presenter I have a love-hate relationship with PowerPoint. On the one hand it’s an essential tool to speak at conferences, at the other it’s got to be the dumbest piece of software I’ve ever run into – and I’m counting the “Hello World” applications we all right. So as conferences are starting the transition to 16:9 projectors there’s an annoying little problem. When you transition from a 4:3 format to a 16:9 format by copying your slides in – or changing the slide dimensions of PowerPoint, it ignores the “LockAspectRatio” checkbox on your images and promptly distorts them. This just looks awkward.

You would think a problem like this would have tons of posts about how to fix it since it’s got to be a common thing – but apparently not. So here’s the short of fixing it – if you’re up for some VBA code.

First, you’ll have to customize the Ribbon to include a developer tab – for that you’ll go File-Options-Customize Ribbon. In the right hand side you’re going to check the open checkbox next to developer. From there click the developer tab then the macro tab. Give the macro any name you want and click edit. This will bring you to the VBA editor. In the editor paste in the following:

Sub ResetAspectRatioForAllImagesInDeck()
For Each thisSlide In Application.ActivePresentation.Slides
For Each thisShape In thisSlide.Shapes
Dim passShape As Shape
Set passShape = thisShape
If thisShape.Type = msoPicture Then
ResetAspectRatio passShape
ElseIf thisShape.Type = msoPlaceholder Then
If thisShape.PlaceholderFormat.ContainedType = msoPicture Then
ResetAspectRatio passShape
End If
End If
Next
Next
End Sub

Sub ResetAspectRatio(ByRef thisShape As Shape)
Dim tempHeight As Single
tempHeight = thisShape.Height
thisShape.LockAspectRatio = msoFalse
Call thisShape.ScaleHeight(1, msoTrue)
Call thisShape.ScaleWidth(1, msoTrue)
thisShape.LockAspectRatio = msoTrue
thisShape.Height = tempHeight
End Sub

This will go through the active presentation and process every shape. It will force the shape to be back in aspect ratio. If for some reason you don’t preserve aspect ratio of your pictures this will reset them – but you shouldn’t be messing around with aspect ratios of your photos anyway. Once you have this code in the editor you can go to the ResetAspectRatioForAllImagesInDeck() line and click the “Play” triangle. All of your images will be fixed. You may still want to tweak positioning but at least you won’t have to deal with the images looking like a hall of mirrors.

4 Comments

  1. Hi, I read a lot your work in your blog, you are standing up with spectacular things! This web site is very enlightening!
    My name is Andreia, I´m from Aveiro, so I will be a follower of this web site, my hobbies may be boring but I will tell them off course I love books as well as tv shows, and I also listen a lot The Cure on my bedroom, I´m without boyfriend now so boys watch out for me….just kidding :)! I already tried online dating It did not work out very well….
    I will also have to apologize for my language it was the only way I get to talk with you guys….
    Good morning to all of you, Bye

  2. Hi Robert,
    I have 154 slides in 4:0 ratio that I need to change to 16:9. Do I have to copy the contents of each slide manually & paste them in the 16:9 slides? Please advise, thanks!

  3. This is setup so it will process all the slides. Just copy all the slides and paste them. You can copy all the slides from the thumbnails or the slide sorter.

  4. Great Directions and Script! It helped out a lot!

    I would recommend the following modification to this script. This modifications keeps the images centered in their original positions. I’m not saying this is better in all situations but it is helpful if you want the images to stay in the same horizontal position on the slide.

    Sub ResetAspectRatioForAllImagesInDeck()
    For Each thisSlide In Application.ActivePresentation.Slides
    For Each thisShape In thisSlide.Shapes
    Dim passShape As Shape
    Set passShape = thisShape
    If thisShape.Type = msoPicture Then
    ResetAspectRatio passShape
    ElseIf thisShape.Type = msoPlaceholder Then
    If thisShape.PlaceholderFormat.ContainedType = msoPicture Then
    ResetAspectRatio passShape
    End If
    End If
    Next
    Next
    End Sub

    Sub ResetAspectRatio(ByRef thisShape As Shape)
    Dim tempHeight As Single
    Dim TempCenter as Single ‘ THIS LINE IS NEW
    tempHeight = thisShape.Height
    TempCenter = thisShape.Left + (ThisShape.Width /2) ‘ THIS LINE IS NEW
    thisShape.LockAspectRatio = msoFalse
    Call thisShape.ScaleHeight(1, msoTrue)
    Call thisShape.ScaleWidth(1, msoTrue)
    thisShape.LockAspectRatio = msoTrue
    thisShape.Height = tempHeight
    thisShape.Left = thisShape.Left + (TempCenter – (thisShape.Left +(ThisShape.Width /2))) ‘ THIS LINE IS NEW
    End Sub


Add a Comment

Your email address will not be published. Required fields are marked *

This site uses Akismet to reduce spam. Learn how your comment data is processed.

Share this: