How to check if a cell has an image?

Question

In Excel, I want to check if a particular cell, for example, has a "C12" image?
How can i do this?

Answer 1

You do this by sorting through the Shapes collection of the worksheet, looking for a form that .TopLeftCell has the same address as your target range.

Answer 2

I had a situation where I wanted to delete pictures (in my diagrams) from selected cells on a sheet and leave others in place, so deleting all pictures was not possible. I left behind some debugging as well as additional code to tell the user what was 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 

Answer 3

The simplest solution is to create a function that returns 1 if the image exists in the cell, 0 if it is not. This only works for individual cells and needs to be modified for ranges with multiple cells.

 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 

Then this code can be run with:

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

Answer 4

 For Each wShape In ActiveSheet.Shapes If (wShape.Type <> 13) Then wShape.Delete ' If the shape doesn't represent a Picture, ' delete Next wShape 

Answer 5

This is a rather old thread, so I don’t know if my post will help anyone, but I ran into a similar problem today and, thinking, found a solution.

First, I saved all the addresses of the ranges where the object exists in the array, and then in the second part of the code, checked the address of each cell in my selected range for each item in the array and performed tagging for the offset cell. if the address of the array element matches the address of the active cell in the selected range. Hope this helps. Here is the code:

 Option Explicit Sub tagging() Dim rng As Range, shp As Shape, n As Integer, arr() As String, m As Integer, arrm As Variant m = 1 n = ActiveSheet.Shapes.Count ReDim arr(n) For Each shp In ActiveSheet.Shapes arr(m) = shp.TopLeftCell.Address m = m + 1 Next For Each rng In Selection m = 1 For Each arrm In arr If rng.Address = arr(m) Then rng.Offset(0, 30).Value = "Yes" Exit For Else rng.Offset(0, 30).Value = "No" End If If m < n Then m = m + 1 Else Exit For End If Next Next End Sub