asked on

Crop a picture in Powerpoint

I would like to know what is wrong with my code below as the cropped image does not end up the right size.

i need the macro to resize the selected image to 12.71cm wide, then to crop off evenly from the top and bottom the left over image above the required height, 3.4cm. There may be instances where the original image is portrait shape but regardless, its needing to be 3.4 x 12.71 in the end.

Sub CropPic()

Dim oSlide As Slide
Dim oPicture As Shape
Dim oshpR As ShapeRange
Dim fd As FileDialog
Dim strFile As String
Dim sngCropSize As Single

' Set oSlide to the first slide in the presentation.
Set oSlide = ActiveWindow.View.Slide
Set oPicture = ActiveWindow.Selection.ShapeRange(1)
oPicture.Width = 363.14
sngCropSize = oPicture.Height - 97.14
oPicture.PictureFormat.CropTop = sngCropSize / 2
oPicture.PictureFormat.CropBottom = sngCropSize / 2
Set oshpR = oSlide.Shapes.Range(Array(oPicture.Name))
End Sub

John Wilson

CropTop and cropBottom crop based on the ORIGINAL size so you need to get the original size and adjust each time the size changes. I think your conversions are slightly out too.

Try:

Sub CropPic()

    Dim oSlide As Slide
    Dim oPicture As Shape
    Dim oshpR As ShapeRange
    Dim fd As FileDialog
    Dim strFile As String
    Dim sngCropSize As Single
    Dim sngOrigHeight As Single
    Dim sngNewheight As Single

    ' Set oSlide to the first slide in the presentation.
    Set oSlide = ActiveWindow.View.Slide
    Set oPicture = ActiveWindow.Selection.ShapeRange(1)
    'Get orig height
    With oPicture.Duplicate
    .ScaleHeight 1, msoTrue
    sngOrigHeight = .Height
    .Delete
    End With
    oPicture.Width = 360.2
        sngNewheight = oPicture.Height
        sngCropSize = (sngNewheight - 96)
        oPicture.PictureFormat.CropTop = (sngCropSize * (sngNewheight / sngOrigHeight)) / 2
        sngNewheight = oPicture.Height
        oPicture.PictureFormat.CropBottom = (sngCropSize * (sngNewheight / sngOrigHeight)) / 2
    Set oshpR = oSlide.Shapes.Range(Array(oPicture.Name))
End Sub

Open in new window

John Wilson

96 should probably be 96.34 I think

RubyFuse

ASKER

Hi JSRWilson

Unfortunately this still doesn't get the right height, even with the 96.34 changed. My end height is 7.45 which is half of the original height.

Any other suggestions?

Thanks Ruby

John Wilson

Did you use all of the code?

ASKER CERTIFIED SOLUTION

John Wilson

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

RubyFuse

ASKER

Yes, used all of the code.

John Wilson

The ammended code seems to do it here.

RubyFuse

ASKER

Excellent, thanks!

RubyFuse

ASKER

If I were to do this for an image size of

RubyFuse

ASKER

Sorry, if I was to do this for an image size of 3.29 x 3.4cm what would need to change? I added in the dimensions but got a result with a minus crop measurement which mean parts of the image were transparent. Happy to post this as a separate question if need be.

John Wilson

If you get a negative value it would mean it's impossible to crop to this size. (it's already less)

You would need to set the height and crop left & right maybe.

John Wilson

If you have 2007 onwards you can use a picture placeholder which will auto crop BTW