i need help modifying an existing VBA to resize images

[danielalvz]

i have an existing VBA code to rezise images, but does no resize to expecific cell width and height, could any one help with the missing pieces to be changes to fix a cell, code is below, thank you in advance
Option Explicit

Public Sub FITIMAGE()
Dim X As Single
Dim Y As Single
With Selection
X = .Width / .Height
End With
With Selection.TopLeftCell
Y = .Width / .RowHeight
End With
Select Case X / Y
Case Is > 1
With Selection
.Width = .TopLeftCell.Width
.Height = .Width / X
End With
Case Else
With Selection
.Height = .TopLeftCell.RowHeight
.Width = .Height * X
End With
End Select
With Selection
.Top = .TopLeftCell.Top
.Left = .TopLeftCell.Left
End With
Exit Sub

End Sub

 

[rollis13]

Your macro is in working condition. Just select the image and launch the macro. As it stands it maintains the aspect ratio of the image.

 

[danielalvz]

Your macro is in working condition. Just select the image and launch the macro. As it stands it maintains the aspect ratio of the image.

hey thanks for your replay, i dont really need the images to maintain the aspect ratio, I basically need it to fit on specific size cell

 

[rollis13]

If I correctly understood this is all you need to adapt your selected image to the cell. The upper left corner of the image has to be in the destination cell.

Option Explicit
Public Sub FITIMAGE()
    With Selection
        'don't care of image aspect ratio
        .ShapeRange.LockAspectRatio = msoFalse
        'set size of image to cell size
        .Width = .TopLeftCell.Width
        .Height = .TopLeftCell.Height
        'align image to the upper left corner of cell
        .Top = .TopLeftCell.Top
        .Left = .TopLeftCell.Left
    End With
End Sub

 

[danielalvz]

If I correctly understood this is all you need to adapt your selected image to the cell. The upper left corner of the image has to be in the destination cell.

Option Explicit
Public Sub FITIMAGE()
    With Selection
        'don't care of image aspect ratio
        .ShapeRange.LockAspectRatio = msoFalse
        'set size of image to cell size
        .Width = .TopLeftCell.Width
        .Height = .TopLeftCell.Height
        'align image to the upper left corner of cell
        .Top = .TopLeftCell.Top
        .Left = .TopLeftCell.Left
    End With
End Sub

perfect just what i needed thanks

 

[rollis13]

Thanks for the positive feedback, glad having been of some help.