Keeping aspect ratio and orientation when inserting pictures

[DasWolf60652]

Hey everyone,

Rory helped me last time get the declaration correct for my function but now my colleague wants to maintain aspect ratio and orientation but still have all the pictures the same size.( either legal or landscape orientation)


I can maintain original aspect ratio by having -1 for both width and height in my Addpictures step.

But in the With shp step, I think I need to use an IF statement to have excel determine whether the width is longer than the height and then set the correct orientation size from there.

Is this possible with my current function or should I have a different function for retrieving the photo information and then divide by cell ratio?

Function insert(PicPath, counter)   
 Dim shp                   As Shape
    With ActiveSheet
    
    
        Set shp = .Shapes.AddPicture(Filename:=PicPath, LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, _
                                     Left:=Range("B" & counter).Offset(2, 0).Left, Top:=Range("B" & counter).Offset(2, 0).Top, _
                                     Width:=-1, Height:=-1)
    End With
    With shp
       
        .LockAspectRatio = msoTrue
          .Height = 210
          .Width = 150
        .Placement = 1
        
    End With


End Function

 

[DasWolf60652]

Function insert(PicPath, counter)
Dim shp As Shape
With ActiveSheet


Set shp = .Shapes.AddPicture(Filename:=PicPath, LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, _
Left:=Range("B" & counter).Offset(2, 0).Left, Top:=Range("B" & counter).Offset(2, 0).Top, _
Width:=-1, Height:=-1)
End With
With shp

.LockAspectRatio = msoTrue
.Height = 210
.Width = 150
.Placement = 1

End With


End Function

 

[DasWolf60652]

I solved this soon after posting...

Function insert(PicPath, counter)
    Dim shp As Shape
    With ActiveSheet
        Set shp = .Shapes.AddPicture(Filename:=PicPath, LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, _
                                     Left:=Range("B" & counter).Offset(2, 0).Left, Top:=Range("B" & counter).Offset(2, 0).Top, _
                                     Width:=-1, Height:=-1)
    End With
    
    With shp
     
        .Line.Weight = 2
        .Line.Visible = msoTrue
        .LockAspectRatio = msoTrue
        .Placement = xlMoveAndSize
            If .Width > .Height Then
                .Height = 202.5
                .Width = 270
                .Top = .Top + 30
                .Left = .Left + 20
            Else
                .Height = 270
                .Width = 202.5
                .Top = .Top + 10
                .Left = .Left + 50
            End If
    End With
End Function