CODEWITHSUNDEEP
vbapowerpoint
WillGreco
WillGreco

Reputation: 29

Resize Image in VBA PowerPoint

I need help in the case below:

I made a code to resize all the images inside a slide, but I'm not able to make each of the images have a different size, when I use the macro all the images of the slide are in a standard.

follow code:

Sub Slide()

    Dim sld As Slide
    Dim img As Shape


    For Each sld In ActivePresentation.Slides
        For Each img In sld.Shapes

            With img                
                If .Type = msoLinkedPicture _
                Or .Type = msoPicture Then
                   .Left = 100
                   .Top = 100
                End If
            End With

        Next
    Next sld

End Sub

Ex: Slide

Upvotes: 2

Views: 3455

Answers (1)

areed1192
areed1192

Reputation: 602

You could store your images in a shape range and then call the different, distribute and align methods on the shape range. For example, I wrote some code that will store the images on a slide in an array, set the height, width & left of the images, and then distribute them vertically.

Sub OrganizingPicsInPPT()

    'Declare the Variables
    Dim PPTSld As Slide
    Dim PPTImg As Shape
    Dim ShpRng As ShapeRange
    Dim ShpArr() As Variant
    Dim ShpCnt As Integer

    'Loop through all the slides in the Actvie Presentation
    For Each PPTSld In ActivePresentation.Slides

        'Initalize my shape count that will be used in my Shape Array
        ShpCnt = 0

        'Loop through all the Shapes on the current slide
        For Each PPTImg In PPTSld.Shapes

            'If the image is linked or a picture then...
            If PPTImg.Type = msoLinkedPicture Or PPTImg.Type = msoPicture Then

               'Increment the shape count.
               ShpCnt = ShpCnt + 1

               'Resize the array, so it matches the shape count.
               ReDim Preserve ShpArr(1 To ShpCnt)

               'Add the Shape to the Array
               ShpArr(ShpCnt) = PPTImg.Name

            End If

        Next PPTImg

        'Set the Shape Range equal to the array we just created.
        Set ShpRng = PPTSld.Shapes.Range(ShpArr)

        'Set the dimensions of the shapes in the ShapeRange.
        With ShpRng

            .Height = 200
            .Width = 300
            .Left = 100

            .Distribute msoDistributeVertically, msoTrue

            'If the shape count is greater than one, I assume you will wanted it centered to the selected object.
            If ShpCnt > 1 Then
                .Align msoAlignCenters, msoFalse
            End If

        End With

        'Clear the array for the next loop
        Erase ShpArr

    Next PPTSld

End Sub

This won't work perfectly in your example, but it should point you in the right direction. The real problem at this point is it's hard to determine how many shapes are on the slide and how you want them arranged. For example, if there are more than three shapes you want the other ones on the right side of the slide? Once we get some clarity on that we can help point you in the right direction.

I would encourage you to use a Shape Range though because there are built-in methods we can leverage in our code.

Upvotes: 1

Related Questions