VBA to scale slide size to PPT Standard 4:3 Maximize

Question

I want to resize my PowerPoint slide size to Standard (4:3) Maximize. I have the code to automatic resized to 4:3, but it defaults to Ensure Fit. How could I change the code to scale the Slide Size to 4:3 Maximize and not Ensure Fit? I've tried looking all over the internet and didn't see a solution.

This is the code I have so far. Thank you in advance!

Public Sub StandardMaximize()

Dim PPPres As Presentation
Application.ActivePresentation.PageSetup.SlideSize = ppSlideSizeCustom
Set PPPres = Application.ActivePresentation

With PPPres.PageSetup
.SlideSize = ppSlideSizeCustom
.SlideWidth = 10 * 72
.SlideHeight = 7.5 * 72
.FirstSlideNumber = 1
.SlideOrientation = msoOrientationHorizontal
.NotesOrientation = msoOrientationVertical
End With
End Sub

Any advice? or this is not possible with vba? – pptbot Sep 19 '19 at 17:11 — pptbot, Sep 19 '19 at 17:11

score 1 · Answer 1 · answered May 18 '22 at 08:01

I think you want to change the slide size from 16:9 to 4:3. If you change the PagetSetup from 16:9 to 4:3 with 'Maximize' option, the height of each shape becomes larger than the height of the updated slide.

You can try the following method. It duplicates the original presentation and adjusts the size and location of each shape according to the rate of slide size difference.It doesn't touch the font size(Powerpoint changes the font size).

Option Explicit

Sub ChangeSlideSize()

Dim pres As Presentation, pres1 As Presentation
Dim sld As Slide, sld1 As Slide, shp As Shape, shp1 As Shape
Dim SW!, SH!, SW1!, SH1!

'Original Presentation
Set pres = ActivePresentation
With pres.PageSetup
    SW = .SlideWidth
    SH = .SlideHeight
End With

'New Presentation
Set pres1 = Presentations.Open(FileName:=pres.FullName, ReadOnly:=msoFalse, _
                    Untitled:=msoTrue, WithWindow:=msoTrue)
With pres1.PageSetup
    .SlideSize = ppSlideSizeOnScreen        '//4:3
    '.SlideSize = ppSlideSizeOnScreen16x9    '// 16:9
    '.SlideSize = ppSlideSizeA4Paper
    SW1 = .SlideWidth
    SH1 = .SlideHeight
End With

'Adjust the size and location of each shape in slides according to the rate
For Each sld1 In pres1.Slides
    Set sld = pres.Slides(sld1.SlideIndex)
    For Each shp1 In sld1.Shapes
        Set shp = sld.Shapes(shp1.ZOrderPosition)
        With shp1
            .Width = SW1 / SW * shp.Width
            .Height = SH1 / SH * shp.Height
            .Left = SW1 / SW * shp.Left
            .Top = SH1 / SH * shp.Top
        End With
    Next shp1
Next sld1

End Sub

score 0 · Answer 2 · edited Oct 02 '19 at 21:02

I did it once in C# with:

pptPresentation.PageSetup.SlideSize = PpSlideSizeType.ppSlideSizeOnScreen;

And do scale it to the full slide size, just create a new CustomLayout which is equal to your Presentation and set your Shape Sizes equal to the CustomLayout.

CustomLayout customLayout = pptPresenation.SlideMaster.CustomLayouts[PpSlideLayout.ppLayoutText]
shape.Height = customLayout.Height;
shape.Width = customLayout.Width;

I did it a long time ago. I hope it helps.

VBA to scale slide size to PPT Standard 4:3 Maximize

2 Answers2