获取插入的图像以在Excel中调整行高

Question

我在将 Excel 中的行高调整为插入的图像时遇到问题。我试过 cell.EntireRow = pic.Height 但它不会调整行以匹配图像高度。它遍历多个工作表以找到代码，然后选择下一个空单元格，以便将图像插入到那里。也不确定这是否是浏览整个工作表的正确方法，因为其中通常不止一张 Photo1。如果我能弄清楚这一点，我就可以使用找到的任何解决方案来制作 photo2 和 photo3。

这是我的代码

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

它目前的样子

Answer 1

您必须使用范围对象的 rowheight 属性：cell.EntireRow.RowHeight= pic.Height

当你写它时（cell.EntireRow = pic.Height）你隐含地使用了cell.EntireRow的默认属性，即value）