Автоматическая ширина изображения метода Shapes.AddPicture с фиксированной высотой

У меня есть код, который помещает изображения с фиксированной высотой и фиксированной шириной в ячейки.

Как изменить этот VBA для размещения изображений - автоматическая ширина на фиксированной высоте (80,5), сохраняя исходное соотношение сторон, используя этот пример из метода Excel Shapes.AddPicture?

Sub URLPicturesInsert()
    
    Dim Rng As Range, cell As Range, filename As String
    Dim Pshp As Shape
    Dim aUrls() As String
    Dim i As Long
    
    
    Application.ScreenUpdating = False
    Set Rng = ActiveSheet.Range("G2:G5")
    
    On Error Resume Next
    
    For Each cell In Rng
        
        If cell.Value <> "" Then
            aUrls = Split(cell.Value, "|")
            
            For i = LBound(aUrls) To UBound(aUrls)
                filename = Trim(aUrls(i))
                
                ActiveSheet.Shapes.AddPicture _
                filename:=filename, _
                LinkToFile:=msoFalse, _
                SaveWithDocument:=msoTrue, _
                Left:=cell.Left + (i * 80.5), _
                Top:=cell.Top, _
                Width:=80.5, _
                Height:=80.5
    
            Next i
            
            cell.EntireRow.RowHeight = 80.5
            
            cell.Value = ""
            
        End If
        
        
    Next cell

Range("G2").Select
Application.ScreenUpdating = True

MsgBox "Process completed successfully", vbInformation, "Success"

End Sub