Get inserted image to adjust the row height in Excel

Question

I am having trouble getting Excel to automatically change the row height to the inserted image. I've used a cell. WholeRow = image Height, but it doesn't change the row's width to correspond to the image height. To find the code, it iterates through numerous worksheets. After finding the code, it chooses the subsequent empty cell and inserts the picture there. Additionally, since there is typically more than one Photo1 on a worksheet, I'm not sure if this is the proper order in which to complete it. If I can work this out, I can apply whatever solution is discovered to photos 2 and 3 as well.

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

Try this:

'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