使用VBA在Excel填充单元格中插入多个图像，但保持纵横比

我已经设法找到了VBA代码，可以将多个图像一次插入到一列单元格中（预定义大小）

然而，图像由横向和纵向组成。

---

我想将纵横比锁定到单元格高度。有没有办法做到这一点？这对于纵向图像来说尤其是一个问题，因为这些图像会拉伸到细胞的水平维度

理想情况下，以单元高度为基准，保持所有纵横比

非常感谢

选择第一个单元格时的我的代码：

Sub InsertPictures()
Dim PicList() As Variant
Dim PicFormat As String
Dim Rng As Range
Dim sShape As Shape
On Error Resume Next
PicList = Application.GetOpenFilename(PicFormat, MultiSelect:=True)
xColIndex = Application.ActiveCell.Column
If IsArray(PicList) Then
    xRowIndex = Application.ActiveCell.Row
    For lLoop = LBound(PicList) To UBound(PicList)
        Set Rng = Cells(xRowIndex, xColIndex)
        Set sShape = ActiveSheet.Shapes.AddPicture(PicList(lLoop), msoFalse, msoCTrue, Rng.Left, Rng.Top, Rng.Width, Rng.Height)
        xRowIndex = xRowIndex + 1
    Next
End If
End Sub

---

使用

sShape.LockAspectRatio=msoCTrue

锁定图像的纵横比，然后重置形状高度。但是，它不能保证图像的质量。最好的方法是保持所有图像的原始大小相似，以获得更好的结果。

可能有兴趣“我想将纵横比锁定为单元格高度”-这里不清楚您的意思。您的意思是要调整图像的大小，使其填充单元格的垂直高度（无论其宽度有多大）？我强烈建议在错误恢复下一步删除

，并修复错误。此行将隐藏所有错误，直到
End Sub
，但是错误仍然会发生，您只是看不到它们的消息。这就像告诉VBA“如果发生错误，请不要告诉任何人”。所以你的代码不起作用，你甚至不知道出了什么问题你可能会从阅读中受益