Change image and row height in response to changes in column width to maintain aspect ratio

[Magic Polygon]

Suppose I have column A, like above, and I lengthen the column. It does this:

Instead of this:

In other words, I don't know how to force other dimensions (image and row height) to change to preserve the aspect ratio and fitted framing of the image made by its containing cell.

'Determine the empty row
EmptyRow = WorksheetFunction.CountA(Range("B:B")) + 1

'Insert and format photo
Set photo = ActiveSheet.Pictures.Insert(ImagePath)
With photo

    .Left = ActiveSheet.Cells(EmptyRow, 1).Left
    .Top = ActiveSheet.Cells(EmptyRow, 1).Top
   
    With .ShapeRange
        .LockAspectRatio = msoTrue
        .Width = Cells(EmptyRow, 1).Width
    End With
   
    'Set the format of the picture cell
    ActiveSheet.Rows(EmptyRow).RowHeight = photo.ShapeRange.Height
   
    .Placement = 1
   
End With

 

[Jaafar Tribak]

You will need to calculate the initial ratio between the columnwidth and rowheight in pixels when first adding the picture and then multiply this ratio by the new columnwidth to get the correct new rowheight.

 

[Fluff]

Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.

Be sure to follow & read the link at the end of the rule too!

Cross posted at: Excel VBA: Transferring user-selected images from a userform to a worksheet with conserved aspect ratio and responsive fit
There is no need to repeat the link(s) provided above but if you have posted the question at other places, please provide links to those as well.

If you do cross-post in the future and also provide links, then there shouldn’t be a problem.