Sub InsertionCellActivePressePapier2()
Dim Img As Object
Dim ratio#, W#, H#
If Application.ActiveSheet.Paste Then
Set Img = ActiveSheet.DrawingObjects(ActiveSheet.Shapes.Count)
With Img.ShapeRange
.LockAspectRatio = msoTrue
ratio = .Width / .Height
W = ActiveCell.Width
H = ActiveCell.Height
If (W / H < ratio) Then
.Width = W
Else
.Height = H - ratio
End If