Since a while I am trying to build a code to insert pictures in a cell in Excel and the result until now was very good. Thanks to several post on this webpage like:
Inserting picture using macro vba to adopt to a merged cell or single cell
VBA inserting picture into specific column of the table
How to insert a picture into Excel at a specified cell position with VBA
Insert picture into Excel and keep aspect ratio without exceeding dimensions with VBA
What I found is that, it does not work when I try to adapt a picture with vertical format 4:3 or 16:9. The height of the photo is bigger than the height from the cell.
Also when I get the dimensions of the picture directly with VBA, the result of the code is that the width is bigger than the high. But, and here comes the interesting part, if I cut the photo only a bit it will work like usual. The code will work and the dimensions are right.
Somehow in those formats 4:3 or 16:9, and when the format is vertical, Excel exchanges the dimensions of the photo. Does anyone know why something like this could happen?
Update: Here is the code that I am using plus a link for one of the picture.
Sub Pictures()
Dim wb As Workbook
Set wb = ActiveWorkbook
counter = 0
strCompFilePath = wb.Sheets("List").Cells(1, 1)
If strCompFilePath <> "" Then
counter = counter + 1
Sheets("Template").Activate
Sheets("Template").Range("A" & counter).RowHeight = 250
Call Insert(strCompFilePath, counter)
End If
End Sub
Function Insert(PicPath, counter)
Dim l, r, t, b
Dim w, h ' width and height of range into which to fit the picture
Dim aspect ' aspect ratio of inserted picture
l = 1: r = 8 ' co-ordinates of top-left cell
t = counter: b = counter ' co-ordinates of bottom-right cell
With Sheets("Template").Pictures.Insert(PicPath)
With .ShapeRange
.LockAspectRatio = msoTrue
.Width = Range("H" & counter).Left + Range("H" & counter).Width - Range("A" & counter).Left
.Height = Range("H" & counter).Top + Range("H" & counter).Height - Range("A" & counter).Top
aspect = .Width / .Height ' calculate aspect ratio of picture
.Top = Range("A" & counter).Top + (Range("A" & counter).Height - .Height) / 2 'left placement of picture
.Left = Range("A" & counter).Left + Range("A:H").Left + (Range("A:H").Width - .Width) / 2 'top left placement of picture
End With
.Placement = 1 'Object is moved and sized with the cells
.PrintObject = True
End With
End Function
Update: Here is the updated code thanks to @RaymonWu:
Sub Pictures()
Dim wb As Workbook
Set wb = ActiveWorkbook
counter = 5
strCompFilePath = wb.Sheets("List").Cells(1, 1)
If strCompFilePath <> "" Then
counter = counter + 1
Sheets("Template").Activate
Sheets("Template").Range("A" & counter).RowHeight = 250
Call Insert(strCompFilePath, counter)
End If
End Sub
Function Insert(PicPath, counter)
With Sheets("Template").Pictures.Insert(PicPath)
With .ShapeRange
.LockAspectRatio = msoTrue
.Height = 250
.Top = Range("A" & counter).Top + (Range("A" & counter).Height -
.Height) / 2 'left placement of picture
.Left = Range("A" & counter).Left + Range("A:H").Left +
(Range("A:H").Width - .Width) / 2 'top left placement of picture
End With
.Placement = 1 'Object is moved and sized with the cells
.PrintObject = True
End With
End Function
And is the line .Height = 250 the one which is not actually working. I am starting to think that the code has no problem itself but Excel. Somehow it recognizes the width of the image as the height and vice versa.
