0

I've managed to find VBA code that inserts multiple images at once in to a column of cells (predefined size).

However, the images consist of landscape and portrait orientations. I want to lock the aspect ratio to cell height. Is there any way to do this? It's especially a problem for the portrait oriented images which get stretched to the horizontal dimensions of the cell.

Ideally, all aspect ratios are kept, with cell height as the benchmark.

Thanks a lot!!

My code when selecting the first cell:

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
Pᴇʜ
  • 56,719
  • 10
  • 49
  • 73
Dimi Mett
  • 21
  • 2
  • [This](https://stackoverflow.com/a/50634741/445425) may be of interest – chris neilsen Sep 26 '19 at 21:54
  • "I want to lock the aspect ratio to cell height" - it's not clear what you mean here. Do you mean you want to size the images such that they fill the vertical height of the cell (regardless of how wide that makes them)? – Tim Williams Sep 27 '19 at 03:24
  • I highly recommend to remove `On Error Resume Next` and fix your errors. This line will hide all errors until `End Sub` but the errors still occur you just cannot see theire message. It is like telling VBA "If an error occurs please don't tell anyone". So your code does not work and you even have no idea that something went wrong. • You might benefit from reading [VBA Error Handling – A Complete Guide](https://excelmacromastery.com/vba-error-handling) – Pᴇʜ Sep 27 '19 at 06:24

1 Answers1

0

Use sShape.LockAspectRatio = msoCTrue to lock the aspect ratio of images and then reset the shape height. however, it would not guarantee the quality of images. The best way would be keep the original size of all images similar to get better result.

Dhirendra Kumar
  • 333
  • 2
  • 5