Forum Discussion
Create a macro to crop images
seanmccole The information on using those properties is pretty sparse, but after a few attempts, I believe the applicable property is the .PictureFormat.Crop.PictureOffsetX and that the offset is from the center of the picture. For the result that you want, probably no offset is required.
Using the following code with an image that was distorted to the size of your image:
With ActiveDocument
For i = 1 To .InlineShapes.Count
With .InlineShapes(i)
.PictureFormat.Crop.ShapeWidth = .Height
.PictureFormat.Crop.ShapeHeight = .Height
.PictureFormat.Crop.PictureOffsetY = 0
.PictureFormat.Crop.PictureOffsetX = 0
End With
Next i
End Withthe result shown compared to an uncropped version of the image
Increasing the offset, by using
.PictureFormat.Crop.PictureOffsetX = 10
reduces the crop from the left
and reducing it by using
.PictureFormat.Crop.PictureOffsetX = -10
increases the crop from the left
Thanks for the reply Doug.
When you select and image in word you see the "Picture Format" ribbon and from there you can "crop" the selected image. You get multiple options here, "crop", "crop to shape", "aspect ratio", "fill" and "fit."
Under the "aspect ratio" tab you get the option to crop to square 1:1.
This is simply all I want to do.
When I create reports for work, the software I use exports small rectangular images which I then have to manually crop to a square and enlarge. Sometimes there can be 50-100 images. This means I have to manually click on each image, click on crop, click on aspect ratio, click on square 1:1, then resize.
I know that's only 5 clicks per image but multiply that over the entire document and it becomes very laborious. I'd really love to have a shortcut key or something that could crop each image or have a macro that would crop all.
Maybe this isn't possible?
Use
Dim myCrop As Crop With ActiveDocument For i = 1 To .InlineShapes.Count With .InlineShapes(i) Set myCrop = .PictureFormat.Crop If .Height > .Width Then myCrop.ShapeHeight = .Width Else myCrop.ShapeWidth = .Height End If End With Next i End WithHi Doug.
This is great! however it crops to the left hand side of the image instead of cropping to the centre. Is there any way to achieve this?This is what happens when I use the macro code that you have kindly supplied...
This is what happens when i crop an image to 1:1
seanmccole The Crop>Aspect Ratio ability is not available in Visual Basic.
There are some other settings that can be applied to the Crop as detailed at
https://docs.microsoft.com/en-us/office/vba/api/overview/library-reference/crop-members-office
and I believe using the .ShapeLeft, .ShapeHeight and .ShapeWidth properties, you can probably achieve what you are after, BUT you would need to know the setting that needs to be used for .ShapeLeft. If that was likely to be constant for all of the images that you want to crop, you could find it by trial and error and then incorporate the setting into the code. If however it is likely to change from one image to the next, you are "up the creek without a paddle"
I believe those properties function in the same way as clicking on the grey area when using the Crop>Aspect Ratio>1:1 and moving the image in relation to the 1:1 shape, before clicking outside of the image to execute the crop.