How to change powerpoint pictures in widescreen format

问题

Hi I'am a Newbee in the world of PowerPoint VBA and hope my english is not too bad: I have to solve the following problem in PowerPoint 2010: First I change into the 16:9 widescreen format, then I go through to every picture which are now too big and change with size-dialog box from the picture only by clicking the up and down arrow for scaling height. The picture will be in the right form which I used before in the 4:3 presentation. That is easy but not if you have to change more then 100 of pictures. I tried so many times but nothing works. Here is my code:

Sub ChangePictures()
Dim sld As Slide
Dim sh As Shape
Dim meinShHeight As Double

ActivePresentation.PageSetup.SlideSize = 15

For Each sld In ActivePresentation.Slides
For Each sh In sld.Shapes
'If sh = msoLinkedOLEObject Or msoTextBox Then
        If sh.Type = msoPicture Then
'meinShHeight = sh.ScaleHeight.Value
'sh.ScaleHeight meinShHeight, msoScaleFromTopLeft
             sh.LockAspectRatio = msoTrue
              With tSlide.Shapes.Select
                  .Height = ActiveWindow.Presentation.PageSetup.SlideHeight
                  .Width = ActiveWindow.Presentation.PageSetup.SlideWidth
             End With
'sh.ScaleHeight  1.75, msoTrue
'sh.ScaleHeight -1.75, msoTrue
        End If
'End If
  Next
Next

End Sub

Perhaps it is impossible to use this up and down arrow trick in VBA? Unfortunately I cannot use PowerPoint 2013 then I didn't have any problem with my presentation.

Is there anybody who can help me. I hope to express my problem in the right way ;-)

Thanks in advance.

Regards Kiki

回答1:

This works for me

Sub ChangePictures()
    Dim sld As Slide
    Dim sh As Shape

    ActivePresentation.PageSetup.SlideSize = 15

    For Each sld In ActivePresentation.Slides
        For Each sh In sld.Shapes
            If sh.Type = msoPicture Then
                With sh
                    .LockAspectRatio = msoTrue
                    .ScaleHeight ActiveWindow.Presentation.PageSetup.SlideHeight, msoTrue
                    .ScaleWidth ActiveWindow.Presentation.PageSetup.SlideWidth, msoTrue
                End With
            End If
        Next
    Next
End Sub

来源：https://stackoverflow.com/questions/21598090/how-to-change-powerpoint-pictures-in-widescreen-format

标签

vba

powerpoint-vba

powerpoint-2010