to insert picture and cropped to fit in the boxes

I am trying to insert pictures on active cells to create a picture report. however, as I go down the activesheet,i.e. row number increase, the picture keeps moving lower from the active cell I am trying to add the picture in. it doesn't also fit nicely in the boxes.
In the picture report, I click on the green cell(picture1) and run the below code to insert the picture into the outlined box as per picture 2. the photos does not keep inside the outlined for the 2nd and 3rd picture, it is shifted down.

    Dim myPic As String
   

    ActiveSheet.Unprotect Password
     '   Get the filename & location of the picture
    myPic = Application.GetOpenFilename( _
        FileFilter:="Images (*.jpg;*.gif;*.png),*.jpg;*.gif;*.png", _
        Title:="Please select an image...")
        If myPic = "False" Then Exit Sub
     
    'Insert picture as Application.ActiveSheet.Shapes.AddPicture(filename, linktofile? FalseNo TrueYes, savewithdoc? TrueYes, Left, Top, Width, Height)'
    Set pic = Application.ActiveSheet.Shapes.AddPicture(myPic, False, True, 0, 0, -1, -1)
    'Set the range of the picture to be (start at active cell.Offset(down,right), activecell,Offset(increase height, increase width)'
    Set Rng = Range(ActiveCell, ActiveCell.Offset(13, 5))
        
        With pic
            .LockAspectRatio = False
            .Height = Rng.Height
            .Width = Rng.Width
            .Left = Rng.Left
            .Top = Rng.Top

Capture2.JPG
Capture.JPG