croping pictures

[Sapphire852]

Hello,

how would vba code look, if i want it to crop the picture currently selected by 10%?

(i've only worked with vba in excel and have never done anything with pictures, so i dont even know where to start)

thanks in advance

[John Wilson]

I would start with the version you have and then:
10% all round?
10% from top?

This might be what you need to get started

Sub cropme()
If ActiveWindow.Selection.Type <> ppSelectionShapes Then Exit Sub
Set oshp = ActiveWindow.Selection.ShapeRange(1)
If oshp.Type <> msoPicture Then Exit Sub
With oshp.PictureFormat
.CropBottom = oshp.Height * 0.1
.CropTop = oshp.Height * 0.1
.CropLeft = oshp.Width * 0.1
.CropRight = oshp.Width * 0.1
End With
End Sub

[Sapphire852]

-------------------

[Sapphire852]

I would start with the version you have and then:
10% all round?
10% from top?

This might be what you need to get started

Sub cropme()
If ActiveWindow.Selection.Type <> ppSelectionShapes Then Exit Sub
Set oshp = ActiveWindow.Selection.ShapeRange(1)
If oshp.Type <> msoPicture Then Exit Sub
With oshp.PictureFormat
.CropBottom = oshp.Height * 0.1
.CropTop = oshp.Height * 0.1
.CropLeft = oshp.Width * 0.1
.CropRight = oshp.Width * 0.1
End With
End Sub

Hello John,

thank you for your answer,

I just tried your code, and on the first "run" of the code, it did crop the picture by the appropriate amount, however, if i tried to run it again (while i still have the picture selected), the picture doesn't crop anymore.

i've looked over and studied your code...the logic appears to be inline with how i could do something similiar in excel do i'm kinda stump right now.

any idea why this is happening?

[John Wilson]

It's because cropleft etc always crops from the original size so the second run is doing the same crop again = no effect

You would need to add in the current crop settings to get what you need (and maybe a little more math)
Sub cropme()
Dim oshp As Shape
Dim oshpW As Single
Dim oshpH As Single

If ActiveWindow.Selection.Type <> ppSelectionShapes Then Exit Sub
Set oshp = ActiveWindow.Selection.ShapeRange(1)
If oshp.Type <> msoPicture Then Exit Sub
oshpH = oshp.Height
oshpW = oshp.Width
With oshp.PictureFormat
.CropBottom = oshpH * 0.1 + .CropBottom
.CropTop = oshpH * 0.1 + .CropTop
.CropLeft = oshpW * 0.1 + .CropLeft
.CropRight = oshpW * 0.1 + .CropRight
End With

End Sub

[romelsms1]

Hi John, about this topic

There any possibility that to crop the white areas of pictures (like in the photo attached)

Can be created an VBA code for that? VBA code can detect shades of color in a picture (white and the rest of colors) ? in ppt 2003

[John Wilson]

I don't think that's possible. (definitely not straightforward)