Using the below code to add pictures to excel when you click in a cell, it works as expected with landscape images but portrait ones are added to the right and above the target cell.
Sub picAdd()
Dim sFile As Variant, r As Range
sFile = Application.GetOpenFilename(FileFilter:="Pic Files (*.jpg;*.JPG;*.JPEG;*.png;*.bmp), *.jpg;*.JPG;*.JPEG;*.png;*.bmp", Title:="Browse to select a picture")
If sFile = False Then Exit Sub
On Error Resume Next
Set r = ActiveCell
On Error GoTo 0
If r Is Nothing Then Exit Sub
If r.Count > 1 Then Exit Sub
ActiveSheet.Pictures.Insert (sFile)
With ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
.LockAspectRatio = True
.Top = r.Top
.Left = r.Left
.Height = r.RowHeight
.Placement = xlMoveAndSize
End With
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("1:2")) Is Nothing Or Target.Cells.CountLarge > 1 Then
Exit Sub
End If
If Not Intersect(Target, Range("J:K")) Is Nothing Then
Call picAdd
End If
End Sub
Hi John,
When I try this code on my machine, everything seems correct (png). Could you put an example of your file or a photo that is problematic.
BR,
Lionel
Hi Lionel I have added the workbook and three pictures and a screen shot of where the macro places them
Clicking in L3 Landscape correct orientation is placed in the correct cell
Clicking in M3 Landscape Upside down is placed below and to the right
Clicking in N3 Portrait is placed up and to the right.
The Portrait one should be resized to fit in the cell vertically as well
the only difference between the pictures is the angle the phone was held at to take the pictures but when selecting them the grab handles are in different positions.
Hi I have tried adding a piece of code to check rotation but that has no effect
...
ActiveSheet.Pictures.Insert (sFile)
If ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Rotation = 0 Or ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Rotation = 180 Then
ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Rotation = 90
End If
With ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
....
regards
John
