can I maintain aspect ratio when inserting pictures

[tryer]

I am using the code below to insert pictures in my spreadsheet. this code resizes the pictures slightly smaller than the target cell and positions it to line up with the top and left hand size. This works fine for pictures that have been taken in landscape mode (as the cells have been resized to accomodate this). However if a picture has been taken in Portrait (camera rotated by 90deg.) then the aspect ratio of the imported picture gets badly distorted as it it stretched widthways to fill the cell.
One way I think it could be done would be if the ratio of width to height could be checked at the point marked in the code below then two seperate resize/insert sections of code could be used. However I don't know how to check the size of the picture after it has been inserted or if ths is even possible.
Any thoughts?

Sub InsertPictureInRange(PictureFileName As String, TargetCells As Range)
    ' inserts a picture and resizes it to fit the TargetCells range
    Dim p As Object, t As Double, l As Double, w As Double, h As Double
    If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
    If Dir(PictureFileName) = "" Then Exit Sub
    ' import picture
    Set p = ActiveSheet.Pictures.Insert(PictureFileName)

' can a check of picture aspect ratio be made here?

    ' determine positions
    With TargetCells
        t = .Top
        l = .Left
        w = .Offset(0, .Columns.Count).Left - .Left - 6
        h = .Offset(.rows.Count, 0).Top - .Top - 6
    End With

    ' position picture
    With p
        .Top = t
        .Left = l
        .Width = w
        .Height = h
    End With
    Set p = Nothing
    Exit Sub


End Sub

[antoka05]

You could use this code:

Sub InsertPictureInRange(PictureFileName As String, TargetCells As Range)
    ' inserts a picture and resizes it to fit the TargetCells range
    Dim p As Object, t As Double, l As Double, w As Double, h As Double
    Dim imgRatio As Single
    
    If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
    If Dir(PictureFileName) = "" Then Exit Sub
    ' import picture
    Set p = ActiveSheet.Pictures.Insert(PictureFileName)
    imgRatio = p.Height / p.Width

    ' can a check of picture aspect ratio be made here?

    ' determine positions
    With TargetCells
        t = .Top
        l = .Left
        w = .Offset(0, .Columns.Count).Left - .Left - 6
        h = .Offset(.Rows.Count, 0).Top - .Top - 6
    End With

    ' position picture
    With p
        .Top = t
        .Left = l
        .Width = w
        .Height = h
        If imgRatio > 1 Then
            .Width = h / imgRatio
            .Left = l + (w - .Width) / 2
        End If
    End With
    Set p = Nothing
    Exit Sub

End Sub

Regards,
Antonio

[tryer]

That works a treat

Thank you