Resize picture to fit merged cell

I have attempted to create a macro that resizes a picture based on the length and width of merged cells. I've ran into two problems: it only works on one picture per sheet (i.e., it will not let me run the same macro on a different picture but will instead resize the first picture again), and it does not fully fit the merged cells. I'm not sure about the first problem, but it seems it's not counting all the rows and columns when calculating the height and width. Any input would be great help!

Sub Resize()
Dim r As Range
Set r = Application.InputBox("Click in the cell to hold the picture", Type:=8)
On Error GoTo 0
If r Is Nothing Then Exit Sub
If r.Count > 1 Then Exit Sub
ActiveSheet.Select
With ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
.LockAspectRatio = True
.Top = r.Top
.Left = r.Left
.Height = r.RowHeight * r.MergeArea.Rows.Count
.Width = r.ColumnWidth * r.MergeArea.Columns.Count
End With
End Sub

Richard,
That's not doing anything for me at all. The picture stays in the same dimensions.

Originally Posted by Richard Buttrey

Hi,

One way perhaps

Sub Resize()

    Dim r As Range, lTop As Long, lLeft As Long, lHeight As Long, lWidth As Long, shp As Shape

    Set r = Application.InputBox("Click in the cell to hold the picture", Type:=8)

    With r    
        lTop = r.Top
        lLeft = r.Left
        lHeight = r.Height
        lWidth = r.Width
    End With

    For Each shp In ActiveSheet.Shapes
        If shp.TopLeftCell.Address = r.Address Then
            With shp
                .LockAspectRatio = msoFalse
                .Top = lTop
                .Left = lLeft
                .Height = lHeight
                .Width = lWidth
            End With
        End If
    Next shp

End Sub

I would prefer for the code to recognize pictures inserted anywhere on the worksheet. Also, it is now working to some extent once the picture is inside the boundaries of the cell. The new problem is that it resizes based on a single cell and not the range of merged cells. Appreciate your help again!

Richard,
I've attached a worksheet where the pictures would be located. As you can see the current code resizes it to fit only B46, but the worksheet I use would require merged columns at the least.

Hi TitansGo,
try to change this part of the Richard's code

With r.MergeArea
    lTop = .Top
    lLeft = .Left
    lHeight = .Height
    lWidth = .Width
End With

Nilem,
Awesome. I made a few more changes below to the code and now it actually works with merged cells. The only other problem I have that needs to be resolved is that the code only works when part of the picture is in the top left cell in the merged cells. You have any ideas for being able to resize it from anywhere on the worksheet?

 With r.MergeArea
        1Top = r.MergeArea.Top
        1Left = r.MergeArea.Left
        1Height = r.MergeArea.Height
        1Width = r.MergeArea.Width

Nilem,
Oops indeed! It still requires the pictures to be within the boundaries of the merged cells. I'll play around with the code some more to see what I come with. Please feel free to do the same. I'm just working by trial and error at this point lol.