Resizing a picture image to fixed height and then cropped width

[Christea685]

Hi All!

I'm trying to make this macro work to help resize images for our fashion Look Book. In theory, it should work. But of course it does not Here is the code we are using:

Sub BIGcrop()




Selection.Height = 507.6


x = Selection.ShapeRange.Width
y = x / 2
Z = y - 144




Selection.ShapeRange.PictureFormat.CropLeft = Z + 185
Selection.ShapeRange.PictureFormat.CropRight = Z + 185


Selection.ShapeRange.LockAspectRatio = msoFalse


Selection.ShapeRange.Width = 288


Selection.ShapeRange.LockAspectRatio = msoTrue




End Sub

I want all my pictures to have a height of 7.05 inches and a width of 4. The height comes out different everytime depending on the scaling of the template I'm using. I need it to adjust accordingly. I'm open to having the image move into merged cells (I read about someone doing that here) as long as it will first adjust the height and then crop the sides (so the orientation stays the same). Any help/suggestions would be SO appreciated!

 

[mole999]

Have you tried "Picture Resizer 6.0" which will do all the dimensioning outside of excel, then you won't end up with too much manipulation in excel

 

[Christea685]

We're trying to do everything on the templates, to make things quicker and more efficient.

 

[Christea685]

I wanted to post the code I ended up with, incase anyone else needs to do something similar:

Sub BIGcrop()
 
Dim x, y, z As Double
 
With ActiveSheet.Shapes("Rectangle 92")
    Selection.Height = .Height
   
 
x = Selection.ShapeRange.Width 'Whole Picture
y = x / 5.45 ' Model Width
z = (x - y) '/ 4 'Width on either side of Model
 
Selection.ShapeRange.LockAspectRatio = msoFalse
 
Selection.ShapeRange.PictureFormat.CropLeft = x - z
Selection.ShapeRange.PictureFormat.CropRight = x - z
 
End With
 
With ActiveSheet.Shapes("Rectangle 92")
    Selection.Top = .Top
    Selection.Left = .Left
   
End With
 
Selection.ShapeRange.ZOrder msoSendToBack
 
End Sub

This code takes the height of the rectangle box on the template (that needs to be replaced by my new picture image), adjusts the picture height accordingly, then crops a portion of each side (you can adjust this by altering what "y" equals).

 

[Rick Rothstein]

I wanted to post the code I ended up with, incase anyone else needs to do something similar:

Just to follow up on the OP's message, this thread (which mole999 responded to) actually appears to be an earlier version of this question asked by the OP five days later, and for which received the answer the OP posted above...

http://www.mrexcel.com/forum/excel-questions/753957-setting-range-shape.html