Link to home
Start Free TrialLog in
Avatar of aws148
aws148

asked on

Macros to Resize and crop inserted images

I am using MS Powerpoint in the Office 2010 suite
I would welcome help with amending a VBA macro precedent (set out below) for the sizing/cropping problem I have while generating a large number of slides from standard size .png images, all of which, after import, seem to need resizing and cropping.
I have been using the “Picture with Caption” template to click and import the .png image, save that I have deleted the Title Box, and need to move the text box to a size of 2.24 cm by 19.6 cm and to a position Horizontal : 2.7 cm from Top Left Corner, and Vertical : 16.33 cm from Top left.
I want to end up with the following parameters for the .png image.
Height : 15.11 cm  Width : 19.54 cm  Rotation : 0º
Scale Height and width : 60%, Lock aspect ratio : yes, Relative to orig picture size : yes
Horizontal : 2.7 cm from Top Left Corner, and Vertical : 1 cm from Top left.
Picture position : Width : 19.54 cm, Offset X : 0 cm, Height : 15.11 cm Offset Y: 0 cm
Crop position : Width : 19.54 cm  Left : 2.75 cm  Height : 15.11 cm  Top: 1 cm
The macro precedent is clearly on the right lines, but I have the following issues
1      the macro  uses inches as the Measurement Unit, but my Control Panel setting is to Metric and all Powerpoint measurements reflect that.  I don't know how to deal with centimeters in terms of points
2      I don’t clearly understand the members of PictureFormat so I’m unclear which parameters to use to achieve the above end result
3      I would like to add in code to delete the Title box from the template
4      I would like to add in code to reposition and resize the text box in the template, to the parameters above
Thanks
Tony

Sub MyCrop()
Dim oshp As Shape
Dim osld As Slide
For Each osld In ActivePresentation.Slides
For Each oshp In osld.Shapes
'if a picture?
If oshp.Type = msoPicture Then
With oshp.PictureFormat
.CropLeft = in2Points(0.28)
.CropRight = in2Points(0.47)
.CropTop = in2Points(1.34)
.CropBottom = in2Points(0.22)
End With
End If
'if a placeholder with a picture in it?
If oshp.Type = msoPlaceholder Then
If oshp.PlaceholderFormat.ContainedType = msoPicture Then
With oshp.PictureFormat
.CropLeft = in2Points(0.28)
.CropRight = in2Points(0.47)
.CropTop = in2Points(1.34)
.CropBottom = in2Points(0.22)
End With
End If
End If

oshp.Width = in2Points(10)
'set the left and top too
oshp.Top  = in2Points(1.03)
oshp.Left = 0
Next oshp
Next osld
End Sub

Function in2Points(inVal As Single) As Single
in2Points = inVal * 72
End Function
ASKER CERTIFIED SOLUTION
Avatar of John Wilson
John Wilson
Flag of United Kingdom of Great Britain and Northern Ireland image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial