Code to dynamically resize picture in powerpoint

Question

I am collecting photos from our employees, and need to do a combination of cropping and resizing in order to make all pictures the same size, and zoom/optimize the part of the picture used (to get everyone's head about the same size).

I was thinking that there must be some way to do this in powerpoint, where I might use a mouseclick & drag to get an approximate target area, then have the code (a) calculate the correct height/width proportions, and (b) crop/zoom as needed. Perhaps there is a way to force the original click/drag selection to already comply with the height/width proportions (locked proportions) so that the only action needed would be the zoom/crop actions.

I'm open to suggestions on the best way to approach this, and code snippets are also always welcome.

Thank you.

Answer 1

Here's one approach:

Add the picture to the slide.

Add a rectangle to the slide; make it the size and location you need to crop to.  Give it a transparent fill so you can see through it to the picture behind.  A bit of VBA could automatically copy/paste this to every slide in the presentation.

Now size and move the photo behind the rectangle until the area you want cropped appears under the rectangle.  Select both the rectangle and the picture, then run this:

Sub CropPicToShape()

' Assumes you've selected the shape that defines the crop

' and the picture in either order

    Dim oShape As Shape

    Dim oPicture As Shape

    ' set up shape references:

    With ActiveWindow.Selection.ShapeRange

        If .Item(1).Type = msoAutoShape Then

            Set oShape = .Item(1)

            Set oPicture = .Item(2)

        Else

            Set oShape = .Item(2)

            Set oPicture = .Item(1)

        End If

    End With

    With oPicture.PictureFormat.Crop

        .ShapeHeight = oShape.Height

        .ShapeWidth = oShape.Width

        .ShapeLeft = oShape.Left

        .ShapeTop = oShape.Top

    End With

End Sub

You could take this a few steps farther, having it automatically pick up a reference to the rectangle via ActiveWindow.SlideRange(1).Shapes("ShapeName") if you give the rectangle a known name before copy/pasting to other slides in the presentation.

And you could also have it automatically delete the rectangle after doing the crop with

oShape.Delete