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

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

CodePudding user response：

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)

CodePudding user response：

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