Help Creating Macro to Crop/Resize Images

ineedmacrohelp · #1 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.

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Help with VBA to resize images	Yuffster	Word VBA	2	01-30-2015 06:05 AM
creating mirror images	gib65	Excel	4	06-12-2014 06:24 AM
save as webpage without creating new images	healthyman	Word	3	04-15-2012 03:51 AM
WORD Macro - import picture - resize - position - page break - loop	Nano07	Word VBA	2	11-02-2011 05:14 AM
Cropped screenshots - lose crop in email	nadder	Office	2	10-20-2010 06:56 PM