CODEWITHSUNDEEP
excelvbashapes
John Sanders
John Sanders

Reputation: 51

How to determine if a Shape exists in a cell in a range?

I exported/copied a sheet of data. That data sheet has checkmark shapes in some of the fields, representing active. I am trying to identify those shapes and if true put a "Yes" in the column next to them and "No" if not.

I borrowed this code for a Function which is in Module - Image Check - that I call from a cmdbtn "Load" that formats this sheet of data before bringing it into my workbook.

Function Check4Image(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
            Check4Image = 1
            'Check4Image = 1
        Else
            Check4Image = 0
        End If
    Next wShape
End Function

Script for the Call

Dim proshaperng As Range
Dim proshapecel
Dim proshapeloc As Range
Dim shapeint As Integer

Set proshaperng = Range("F4", "F" & shapeint)   
Set proshapeloc = Range("F4", "F" & shapeint).Cells

For Each proshapecel In proshaperng
    proshapeloc = Range(proshapecel.Address)
    'proshapeloc.Select
        
    Call Check4Image(proshapeloc)
    If Check4Image(proshapeloc) = 1 Then
        proshapeloc.Offset(0, 1) = "Yes"
    Else
        proshapeloc.Offset(0, 1) = "No"
    End If
Next proshapecel

I tried

  1. In standard Excel Fx =Check4Image(Cell) and this returns the "1" I expect when the cell has a shape in it

  2. Changing the function to a Variant or another variable type Due to a Run Time error 13 Type Mismatch

My thought is that it wants a range and when I try to give it a range it gives me object errors. This may be because the workbook /sheet I'm copying is open during this process.

This worked but for a specific cell reference:

Set proshapeloc = ThisWorkbook.Worksheets("ProcessList").Range("F4")

Upvotes: 0

Views: 1987

Answers (1)

Tim Williams
Tim Williams

Reputation: 166126

You need a different test:

If wShape.TopLeftCell = CellToCheck Then

...this only compares the cell values, not whether they're the same cell.

Something like this would work:

'return any image in the passed cell (or Nothing if none)
Function FindImage(CellToCheck As Range) As Shape
    Dim wShape As Shape, addr
    addr = CellToCheck.Address
    For Each wShape In CellToCheck.Parent.Shapes 'more flexible
        If wShape.TopLeftCell.Address = addr Then
            Set FindImage = wShape
            Exit Function
        End If
    Next wShape
End Function

Sub Tester()
    Dim c As Range
    For Each c In Range("A1:A10").Cells
        c.Offset(0, 1) = IIf(FindImage(c) Is Nothing, "No", "Yes")
    Next c
End Sub

Upvotes: 1

Related Questions