如何使用VBA保持从链接粘贴的图像的纵横比？

Sub KeepAspectRatio()
    Dim rng As Range
    Dim shp As Shape
    Dim originalWidth As Double
    Dim originalHeight As Double
    Dim ratio As Double
    
    ' 选择或定位到要调整大小的图像所在的单元格
    Set rng = Range("A1")
    
    ' 检查所选单元格中是否有图像
    If rng.InlineShapes.Count = 0 Then
        MsgBox "No image found in the selected cell."
        Exit Sub
    End If
    
    ' 获取图像对象
    Set shp = rng.InlineShapes(1)
    
    ' 获取原始图像的宽度和高度
    originalWidth = shp.Width
    originalHeight = shp.Height
    
    ' 计算调整比例
    ratio = originalWidth / originalHeight
    
    ' 调整图像大小，保持纵横比
    If originalWidth > originalHeight Then
        shp.Width = rng.Width
        shp.Height = rng.Width / ratio
    Else
        shp.Height = rng.Height
        shp.Width = rng.Height * ratio
    End If
End Sub