如何确定范围内的单元格中是否存在形状？答案

【问题标题】：How to determine if a Shape exists in a cell in a range?如何确定范围内的单元格中是否存在形状？
【发布时间】：2021-04-22 01:55:01
【问题描述】：

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

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

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) 中，当单元格中有形状时，它会返回我期望的“1”
由于运行时错误 13 类型不匹配而将函数更改为 Variant 或其他变量类型

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

这可行，但对于特定的单元格引用：

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

【问题讨论】：

您实际上并没有说出问题所在 - 您建议该功能有效吗？一件事是我认为您应该在比较中使用Address 属性。
问题是当调用函数时我得到一个不匹配错误，因为代码正在通过函数：对于 ActiveSheet.Shapes 中的每个 wShape 如果 wShape.TopLeftCell = CellToCheck Then - 错误发生类型不匹配当您将静态单元格放入 = Check4Image(F4) 时，从 excel 运行的函数将在形状处于 F4 时返回“1”。但由于某种原因，我无法让它在 For Each 循环中传递动态范围的变量
你所说的“动态变量范围”是什么意思 - 请说明你是如何做到这一点的？
感谢 SJR，我试图通过函数传递一系列单元格，以便独立评估每个单元格，但每次它要么不匹配，要么不评估单元格地址。感谢您的帮助！

标签： excel vba shapes

【解决方案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

【讨论】：