2

I am in my first week of learning VBA, and I am looking for a VBA code that will help me resize and reposition pictures pasted into PowerPoint 2016. The desired picture format details are below:

Size
- Height = 3.39"
- Width = 6.67"
- Rotation = 0
- Scale Height = 62%
- Scale Width = 62%
- Aspect Ratio = Locked
- Relative to original picture size = true

Position
- Horizontal position = 0
- Top Left Corner
- Vertical position = 2.06
- Top Left Corner

Any help would be greatly appreciated.

Marcucciboy2
  • 3,156
  • 3
  • 20
  • 38
PSR
  • 71
  • 1
  • 2
  • 7

3 Answers3

4

Below is the code that worked for me. Thanks for the support.

Sub ResizeAll()
For Each tSlide In ActiveWindow.Presentation.Slides
    tSlide.Select
    With tSlide.Shapes.Item(1)
    'assume a blank slide with one image added only
        .Select
        .Height = 72 * 3.39
        .Width = 72 * 6.67
    'algin middle (Horizontal Center)
        .Left = 0
        .Top = ActivePresentation.PageSetup.SlideHeight / 3.25
    End With
Next
End Sub
PSR
  • 71
  • 1
  • 2
  • 7
  • 1
    While it's not necessary to remove both of the .Select statements, neither of them is necessary, and without them, your code will run more quickly. – Steve Rindsberg Nov 15 '20 at 21:19
2

Okay, so this macro will adjust the details of every picture within your powerpoint.

Sub AdjustImages()

    Dim curSlide As Slide
    Dim curShape As Shape

    For Each curSlide In ActivePresentation.Slides
        For Each curShape In curSlide.Shapes
            With curShape

                'size:
                ''1 inch = 72 points
                .Height = 72 * 3.39
                .Width = 72 * 6.67

                .ScaleHeight 0.62, msoTrue
                .ScaleWidth 0.62, msoTrue

                .LockAspectRatio = msoTrue


                'position:
                .Rotation = 0

                .Left = 0
                .Top = 2.06

                'Relative to original picture size = true

            End With
        Next curShape
    Next curSlide

End Sub

The only part of your question that I don't really understand is when you mention it being "relative to original picture size = true". I can't seem to find an attribute that matches that.

Marcucciboy2
  • 3,156
  • 3
  • 20
  • 38
0

ub AdjustImages()

Dim curSlide As Slide
Dim curShape As Shape

For Each curSlide In ActivePresentation.Slides
    For Each curShape In curSlide.Shapes
        With curShape

            'size:
            ''1 inch = 72 points
            .Height = 72 * 3.39
            .Width = 72 * 6.67

            .ScaleHeight 0.62, msoTrue
            .ScaleWidth 0.62, msoTrue

            .LockAspectRatio = msoTrue


            'position:
            .Rotation = 0

            .Left = 0
            .Top = 2.06

            'Relative to original picture size = true

        End With
    Next curShape
Next curSlide

End Sub

  • How to do it for single image in each slides – San Kar Apr 27 '23 at 08:49
  • As it’s currently written, your answer is unclear. Please [edit] to add additional details that will help others understand how this addresses the question asked. You can find more information on how to write good answers [in the help center](/help/how-to-answer). – Community Apr 30 '23 at 12:08