时间戳

首页 > 解决方案 > 使用VBA在Excel填充单元格中插入多个图像，但保持纵横比

excel - 使用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

标签： excelvbaimage

解决方案

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

推荐阅读