CODEWITHSUNDEEP
excelvbaexcel-formula
FinDev
FinDev

Reputation: 439

VBA: How to check IF a specific cell contains an image and then delete the image if it exists

In the sheet titled Counter Party Select , I'd like to check if cell D2 contains and imagine. If the cell does indeed contain an image (picture), I'd like to delete that picture. The code that I'm trying to use fails on the line Set thing = Sheets("Counter Party Select").Range("D2").Select.

The error message is Run-time error 4242. Object Required. What code should I use?

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

Upvotes: 1

Views: 1493

Answers (3)

VBasic2008
VBasic2008

Reputation: 54787

Delete Picture From Cell

  • The following is a solution that uses (calls) the deletePictureFromCell procedure.
  • Instead of the cell objects used in your (valid) solution, deletePictureFromCell uses their addresses.

The Code

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

Your Code

  • You can rewrite your code using the With statement.
  • Note the dots (.): .Unprotect, .Pictures and .Range("D2").
  • It is not necessary to use Application in front of Intersect, although it might be good practice to remember that it is a method of the Application object, and not the Workbook object.

Refactored

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

Upvotes: 2

DeanOC
DeanOC

Reputation: 7262

As you want the value of the cell D2, you should use

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

Upvotes: 1

FinDev
FinDev

Reputation: 439

I figured out a way to do this using a for loop:

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

Upvotes: 0

Related Questions