如何在Excel VBA中同时控制插入对象的宽度与高度？

直接硬设Width和Height会强制拉伸图片、覆盖原始比例，所以得按图片本身的宽高比缩放，同时保证不超过你指定区域的最大宽高上限。

修改后的代码如下，核心是先计算图片原始比例，再根据目标区域尺寸判断缩放方向：

Sub Add_logo()
    Dim fNameAndPath As Variant
    Dim img As Picture
    Dim originalWidth As Double, originalHeight As Double
    Dim maxWidth As Double, maxHeight As Double
    Dim scaleRatio As Double
    
    fNameAndPath = Application.GetOpenFilename(Title:="Select picture to be imported")
    If fNameAndPath = False Then Exit Sub
    Set img = ActiveSheet.Pictures.Insert(fNameAndPath)
    
    ' 保存图片原始宽高和目标区域的最大宽高
    originalWidth = img.Width
    originalHeight = img.Height
    maxWidth = ActiveSheet.Range("Y11:AL11").Width
    maxHeight = ActiveSheet.Range("Y11:Y13").Height
    
    ' 取宽度/高度缩放比例里的较小值，保证图片不超出限制且比例不变
    scaleRatio = WorksheetFunction.Min(maxWidth / originalWidth, maxHeight / originalHeight)
    
    With img
        .Name = "Logo"
        .Left = ActiveSheet.Range("Y11").Left
        .Top = ActiveSheet.Range("Y11").Top
        ' 按比例设置最终尺寸
        .Width = originalWidth * scaleRatio
        .Height = originalHeight * scaleRatio
        .PrintObject = True
    End With
End Sub

关键逻辑说明 #

• 先记录图片原始宽高，避免插入后默认尺寸干扰计算
• 计算目标区域的最大允许宽度和高度
• 用WorksheetFunction.Min取两个缩放比例的较小值，确保缩放后的图片既不超宽也不超高，同时保留原始比例
• 最后按计算后的尺寸设置图片，不会出现覆盖或拉伸变形的问题

内容的提问来源于stack exchange，提问作者Dan Parsloe