Excel VBA：如何检查特定单元格是否包含图像，然后删除图像（如果存在）

在标题为

Counter Party Select

的表格中，我想检查单元格

D2

是否包含和想象。如果单元格确实包含图像（图片），我想删除该图片。我尝试使用的代码在

Set thing=Sheets（“对方选择”）.Range（“D2”）.Select一行失败

错误消息是运行时错误4242。所需对象

。我应该使用什么代码

Sub Logo_Fill()

    Dim myImage As Shape
    Dim thing As Object
    Set thing = Sheets("Counter Party Select").Range("D2").Select
    
    If TypeName(thing) = "Picture" Then
        Set myImage = ActiveSheet.Shapes("Picture 1")
        myImage.Delete
    End If

End Sub

---

我想出了一个使用for循环的方法：

Sub Logo_Fill()

    Dim pic As Picture

    Sheets("Counter Party Select").Unprotect
    
    For Each pic In Sheets("Counter Party Select").Pictures
        If Not Application.Intersect(pic.TopLeftCell, Range("D2")) Is Nothing Then
            pic.Delete
        End If
    
    Next pic

End Sub

---

由于需要单元格D2的值，因此应使用

Dim myImage As Shape
Dim thing As Variant
thing = Sheets("Counter Party Select").Range("D2").Value

从单元格中删除图片

• 以下是一个使用（调用）

  deletePictureFromCell

  过程的解决方案
• 与（有效）解决方案中使用的单元格对象不同，

  deletePictureFromCell

  使用它们的地址

代码

Option Explicit

Sub Logo_Fill()
    
    Const wsName As String = "Counter Party Select"
    Const CellAddress As String = "D2"
    Dim wb As Workbook: Set wb = ThisWorkbook ' The workbook with this code.
    
    Dim ws As Worksheet: Set ws = wb.Worksheets(wsName)
    Dim pic As Picture
    
    deletePictureFromCell pic, ws, CellAddress

End Sub

Sub deletePictureFromCell(ByRef PictureObject As Picture, _
                          Optional Sheet As Worksheet, _
                          Optional ByVal CellAddress As String = "A1")
    
    If Sheet Is Nothing Then Set Sheet = ActiveSheet
    
    For Each PictureObject In Sheet.Pictures
        If PictureObject.TopLeftCell.Address(False, False) _
          = Replace(CellAddress, "$", "") Then
            PictureObject.Delete
            ' If only one picture per cell, this could increase efficiency:
            'Exit For ' No need to loop anymore.
        End If
    Next PictureObject
   
End Sub

你的代码

• 您可以使用

  With

  语句重写代码
• 注意点（
  ）：

  .Unprotect

  ，

  .Pictures

  和

  范围（“D2”）

• 无需在

  Intersect

  前面使用

  应用程序

  ，尽管可能是一种好的做法，记住它是

  应用程序

  对象的方法，而不是

  工作簿

  对象

重构

Sub Logo_Fill2()

    Dim pic As Picture

    With Sheets("Counter Party Select")
        .Unprotect
        For Each pic In .Pictures
            If Not Intersect(pic.TopLeftCell, .Range("D2")) Is Nothing Then
                pic.Delete
            End If
        Next pic
    End With

End Sub

---

您没有限定

范围（“D2”）

。下面是一个演示代码何时可能失败的练习：在同一工作簿中选择另一张工作表（而不是

对方选择

）。现在从

VBE

运行代码。它将失败，并显示以下消息：

运行时错误“1004”：对象“\u应用程序”的方法“Intersect”失败

。解决方案是限定范围：

工作表（“交易对手选择”）。范围（“D2”）

。