How to check if a cell has a picture?

You do this by looping through Shapes collection of the worksheet, looking for a shape whose .TopLeftCell has same address as your target range.


I had a situation where I wanted to delete pictures (In my case charts) from selected cells on a worksheet and leave others in place therefore removing all pictures was not an option. I've left behind some debugging and also some extra code to tell the user what is going on.

Public Sub RemoveUnWantedGraphs()

    Dim shp As Shape
    Dim rangeToTest As Range
    Dim c As Range
    Dim shpList

    'Set the rangeToTest variable to the selected cells
    Set rangeToTest = Selection

    'Loop Over the the selected cells
    For Each c In rangeToTest


        'Inner loop to iterate over the shapes collection for the activesheet
        Set shpList = ActiveSheet.Shapes
        For Each shp In shpList

            Application.StatusBar = "Analysing:- " + c.Address + " Graphs To Find:- " & shpList.Count


            'If the address of the current cell and the address
            'of the shape are the same then delete the shape
            If c.Address = shp.TopLeftCell.Address Then

                Debug.Print "Deleting :- " & shp.Name
                shp.Delete

                DoEvents
            End If

        Next shp

    Next c

    Application.StatusBar = ""

    MsgBox "All Shapes In Range Deleted"

End Sub

The simplest solution is to create a function that will return 1 if image exists in cell, 0 if it does not. This only works for individual cells and needs modified for multi-cell ranges.

Function CellImageCheck(CellToCheck As Range) As Integer
' Return 1 if image exists in cell, 0 if not

    Dim wShape As Shape

    For Each wShape In ActiveSheet.Shapes
        If wShape.TopLeftCell = CellToCheck Then
            CellImageCheck = 1
        Else
            CellImageCheck = 0
        End If
    Next wShape

End Function

This code can then be run using:

Sub testFunction()

    If CellImageCheck(Range("B6")) Then
        MsgBox "Image exists!"
    Else
        MsgBox "Image does not exist"
    End If

End Sub