Rezise image to fit cell but keeping aspect ratio

[sharky12345]

I'm looking at a way to resize an image placed into a cell so that it does not exceed the cell height or width whilst maintaining it's aspect ratio, in other words as soon as the height or width meets the cell width or height then it stops resizing.

I've found this in another post which goes some way, but this fills the whole cell and ignores the aspect ratio - does anyone know of how I could amend this to do what I need?

Sub piccy()
 Dim sFile As Variant, r As Range
 sFile = Application.GetOpenFilename(FileFilter:="Pic Files (*.jpg;*.bmp), *.jpg;*.bmp", Title:="Browse to select a picture")
 If sFile = False Then Exit Sub
 On Error Resume Next
 Set r = Application.InputBox("Click in the cell to hold the picture", Type:=8)
 On Error GoTo 0
 If r Is Nothing Then Exit Sub
 If r.Count > 1 Then Exit Sub
 ActiveSheet.Pictures.Insert (sFile)
 With ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
 .LockAspectRatio = False
 .Top = r.Top
 .Left = r.Left
 .Height = r.RowHeight * r.MergeArea.Rows.Count
 .Width = r.ColumnWidth * r.MergeArea.Rows.Count
 End With
 End Sub