Вставка нескольких изображений в ячейки заполнения Excel с использованием VBA, но с сохранением соотношения сторон

Question

Мне удалось найти код 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

Answer 1

Используйте sShape.LockAspectRatio = msoCTrue, чтобы зафиксировать соотношение сторон изображений, а затем сбросьте высоту формы.однако это не будет гарантировать качество изображений.Лучшим способом было бы сохранить исходный размер всех изображений одинаковым, чтобы получить лучший результат.