Log in

View Full Version : Problem with macro which position, scale and crop an image



matrou
08-07-2017, 09:22 AM
Hi guys,

I'm trying to do a macro which take each parameter used in powerpoint in format picture/crop.

Crop
Picture position
Width Value height Value
Offset X Value Offset Y Value
Crop Position
Width Valueheight Value
Left Value Top Value

I've only problems with offset X and offset Y which doesn't update when I'm using the macro.
For the other things, it takes the value I've got. I'm using a function to change the units to centimeter.

Here below is the code used :


Function in2Points(inVal As Single) As Single
in2Points = inVal * 72 / 2.54
End Function

Sub MyCrop2()
Dim oShp As Shape
Set oShp = ActiveWindow.Selection.ShapeRange(1)
If oShp.Type = msoPicture Then
'is it a picture?
With oShp.PictureFormat
.Crop.PictureWidth = in2Points(11.95)
.Crop.PictureHeight = in2Points(8.99)
.Crop.PictureOffsetX = in2Points(1.46)
.Crop.PictureOffsetY = in2Points(1.09)
.Crop.ShapeWidth = in2Points(8.08)
.Crop.ShapeHeight = in2Points(6.17)
.Crop.ShapeLeft = in2Points(8.96)
.Crop.ShapeTop = in2Points(0.32)
End With
End If
'is it a placeholder with a picture in it?
If oShp.Type = msoPlaceholder Then
If oShp.PlaceholderFormat.ContainedType = msoPicture Then
With oShp.PictureFormat
.Crop.PictureWidth = in2Points(11.95)
.Crop.PictureHeight = in2Points(8.99)
.Crop.PictureOffsetX = in2Points(1.46)
.Crop.PictureOffsetY = in2Points(1.09)
.Crop.ShapeWidth = in2Points(8.08)
.Crop.ShapeHeight = in2Points(6.17)
.Crop.ShapeLeft = in2Points(8.96)
.Crop.ShapeTop = in2Points(0.32)
End With
End If
End If
'you will probably want to set the left and top too
End Sub

Thank you for your help!