如何确定某个范围内的单元格中是否存在 Shape？

Question

我exported/copied一个sheet的数据。该数据 sheet 在某些字段中具有复选标记形状，表示处于活动状态。我正在尝试识别这些形状，如果为真，则在它们旁边的列中输入“是”，否则为“否”。

我为模块中的一个函数借用了这段代码 - 图像检查 - 我从一个 cmdbtn“加载”调用它，在将它引入我的工作簿之前格式化这个 sheet 数据。

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

调用脚本

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

我试过了

在标准中 Excel Fx =Check4Image(Cell) 和这个 returns 当单元格中有形状时我期望的“1”
由于运行时间错误 13 类型不匹配
将函数更改为 Variant 或其他变量类型

我的想法是它需要一个范围，当我试图给它一个范围时它给我对象错误。这可能是因为我正在复制的工作簿/sheet在此过程中处于打开状态。

这有效，但针对特定的单元格引用：

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

Answer 1

您需要一个不同的测试：

If wShape.TopLeftCell = CellToCheck Then

...这只会比较单元格值，而不是它们是否是同一个单元格。

像这样的东西会起作用：

'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

如何确定某个范围内的单元格中是否存在 Shape？

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

excel

vba

shapes