Using VBA to set size and placement of picture

[melodramatic]

I have a macro that automatically places all photos from a folder into a file, and sizes them to fit the width, placing them at the top of the cell to which they're assigned (or actually, 1.5 down from the top).

In deciding to make a change so that the macro will automatically decide if a photo needs to be rotated, it now will read if the photo is truly landscape, or if it's portrait and needs to be flipped to landscape. That part works well.

What doesn't work is that if the photo is not rotated, it lines up at the top of the cell - no problem. However, if it's one of the ones that had to be rotated by 270, it sizes correctly, but does not line up at the top of the cell.

I've tried lining it up by using
Selection.ShapeRange.IncrementTop 1.5
the second photo goes over the first photo (about 1/2" down).

If I use
Selection.ShapeRange.Top = Range("A" & ArrayRow).Top
Selection.ShapeRange.Left = Range("A" & ArrayRow).Left
Each of the photos starts about 1/2" down from the top of the cell.


Either of these methods work well for the naturally landscaped photos (that don't have to be rotated). Is there some secret about it having been rotated that means I should use a different way of doing it?

                ActiveSheet.Pictures.Insert(PhotoFile).Select
                    Selection.ShapeRange.LockAspectRatio = msoTrue
                    'The below resize is to scale it based on original size, as some photos are too large to fit correctly and resize off-scale when inserted
                    Selection.ShapeRange.ScaleHeight 0.05, msoTrue, msoScaleFromTopLeft
                    Selection.ShapeRange.ScaleWidth 0.05, msoTrue, msoScaleFromTopLeft
                   
                    Selection.ShapeRange.Line.Visible = msoFalse
                    Selection.ShapeRange.LockAspectRatio = msoFalse
                    If Selection.Width > Selection.Height Then
                        Selection.ShapeRange.IncrementRotation 0
                        Selection.ShapeRange.Height = 340
                        Selection.ShapeRange.Width = 456
                        'Selection.ShapeRange.IncrementTop 1.5
                        Selection.ShapeRange.Top = Range("A" & ArrayRow).Top
                        Selection.ShapeRange.Left = Range("A" & ArrayRow).Left
                    Else
                        Selection.ShapeRange.IncrementRotation 270
                        Selection.ShapeRange.Height = 456
                        Selection.ShapeRange.Width = 340
                        Selection.ShapeRange.IncrementTop 1.5
                        'Selection.ShapeRange.Top = Range("A" & ArrayRow).Top
                        'Selection.ShapeRange.Left = Range("A" & ArrayRow).Left
                    End If

 

[melodramatic]

OK, I've been playing with what I could find online, and I have a solution, I think. The only problem with this solution is that it works for all of the pictures EXCEPT for the first one, but only if that first one falls under the "Else" statement. If the first pic falls in the first part of the If statement, then all is fine.

What do I do here?

                    If Selection.Width > Selection.Height Then
                        With Selection.ShapeRange
                            .Height = 340
                            .Width = 456
                            .Top = Range("A" & ArrayRow).Top - 1.5
                            .Left = Range("A" & ArrayRow).Left
                        End With
                    Else
                        With Selection.ShapeRange
                            .Rotation = 270
                            .Height = 456
                            .Width = 340
                            .Top = Range("A" & ArrayRow).Top - 56
                            .Left = Range("A" & ArrayRow).Left
                        End With
                    End If

 

[melodramatic]

What I've done in the meantime, is I've added an If statement as follows:

If Selection.Width > Selection.Height Then
                        With Selection.ShapeRange
                            .Height = 340
                            .Width = 456
                            .Top = Range("A" & ArrayRow).Top - 1.5
                            .Left = Range("A" & ArrayRow).Left
                        End With
                    Else
                        With Selection.ShapeRange
                            .Rotation = 270
                            .Height = 456
                            .Width = 340
                            .Top = Range("A" & ArrayRow).Top - 56
                            .Left = Range("A" & ArrayRow).Left
                        End With
                        If PhotoNum = 1 Then
                            EndCorrect = True
                        End If
                    End If

And at the end of the macro, have added...

    If EndCorrect = True Then
        ActiveSheet.Shapes.Range(Array("Picture 1")).Select
        Selection.ShapeRange.IncrementTop -56
   End If

This way, it goes back to move that misplaced 1st pic up 56 to the top of the cell, but only if it was a portrait that required it.