Get inserted image to adjust the row height in Excel - excel

Question

I am having an issue getting the row height to adjust in Excel to the inserted image. I have tried cell.EntireRow = pic.Height but it does not adjust the row to match image height. It loops through several worksheets to find the code then selects the next empty cell to it so the image gets inserted there. Also not sure if this is the correct way to go through the entire worksheet as the is usually more that one Photo1 in there. If I can get this figured out, I can do the photo2 and photo3 using whatever solution is found.
Here is my code
Private Sub cmdInsertPhoto1_Click()
'insert the photo1 from the folder into each worksheet
Dim ws As Worksheet
Dim fso As FileSystemObject
Dim folder As folder
Dim rng As Range, cell As Range
Dim strFile As String
Dim imgFile As String
Dim localFilename As String
Dim pic As Picture
Dim findit As String
Application.ScreenUpdating = True
'delete the two sheets if they still exist
For Each ws In ActiveWorkbook.Worksheets
If ws.Name = "PDFPrint" Then
Application.DisplayAlerts = False
Sheets("PDFPrint").Delete
Application.DisplayAlerts = True
End If
Next
For Each ws In ActiveWorkbook.Worksheets
If ws.Name = "DataSheet" Then
Application.DisplayAlerts = False
Sheets("DataSheet").Delete
Application.DisplayAlerts = True
End If
Next
Set fso = New FileSystemObject
Set folder = fso.GetFolder(ActiveWorkbook.Path & "\Photos1\")
'Loop through all worksheets
For Each ws In ThisWorkbook.Worksheets
ws.Select
Set rng = Range("A:A")
ws.Unprotect
For Each cell In rng
If cell = "CG Code" Then
'find the next adjacent cell value of CG Code
strFile = cell.Offset(0, 1).Value 'the cg code value
imgFile = strFile & ".png" 'the png imgFile name
localFilename = folder & "\" & imgFile 'the full location
'just find Photo1 cell and select the adjacent cell to insert the image
findit = Range("A:A").Find(what:="Photo1", MatchCase:=True).Offset(0, 1).Select
Set pic = ws.Pictures.Insert(localFilename)
With pic
.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Width = 200
.ShapeRange.Height = 200 'max row height is 409.5
.Placement = xlMoveAndSize
End With
cell.EntireRow = pic.Height
End If
'delete photo after insert
'Kill localFilename
Next cell
Next ws
Application.ScreenUpdating = True
' let user know its been completed
MsgBox ("Worksheets created")
End Sub
What it currently looks like

Answer 1

You have to use the rowheight property of the range object: cell.EntireRow.RowHeight= pic.Height
As you wrote it (cell.EntireRow = pic.Height) you implicitly used the default property of cell.EntireRow which is value)

Answer 2

Managed to solve it. for anyone else its cell was selected so, this works for me:
'just find Photo1 cell and select the adjacent cell to insert the image
findit = Range("A:A").Find(what:="Photo1", MatchCase:=True).Offset(0, 1).Select
ActiveCell.EntireRow.RowHeight = 200 'max row height is 409.5
Set pic = ws.Pictures.Insert(localFilename)
With pic
.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Width = 200
'.ShapeRange.Height = 200 'max row height is 409.5
.ShapeRange.Height = ActiveCell.MergeArea.Height
.ShapeRange.Top = ActiveCell.MergeArea.Top
.ShapeRange.Left = ActiveCell.MergeArea.Left
.Placement = xlMoveAndSize
End With