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.Con tainedType = 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
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.Con
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
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.