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