Microsoft Office Forums - View Single Post - [Solved] Help Creating Macro to Crop/Resize Images

ineedmacrohelp · 08-06-2015, 06:46 AM

I ended up figuring it out in Word. The Excel thing was getting messy. Here is the code:

Code:

Sub BackupCropperResizer()
'
' BackupCropperResizer Macro
'
'
  Dim sngWidth, sngCrop As Single
 sngCrop = 3.075
 
 
 Selection.WholeStory
 
With Selection.InlineShapes(1)
 sngWidth = .Width
 With .PictureFormat
 .CropRight = sngWidth * sngCrop
 End With
 End With
 
 On Error Resume Next
 With Selection.InlineShapes(2)
 sngWidth = .Width
 With .PictureFormat
 .CropRight = sngWidth * sngCrop
 End With
 End With
 
On Error Resume Next
With Selection.InlineShapes(3)
 sngWidth = .Width
 With .PictureFormat
 .CropRight = sngWidth * sngCrop
 End With
 End With
 
 
 Dim i As Long
With ActiveDocument
 For i = 1 To .InlineShapes.Count
 With .InlineShapes(i)
 .ScaleHeight = 33
 End With
 Next i
End With
 
End Sub

I couldn't get the cropper to work in a For Loop for some reason so I cut the corner and used On Error Resume Next. For my purpose I only have three images max, so this works out fine.