如何检查一个单元格是否有图片？

Question

在 Excel 中，我想检查特定单元格（例如“C12”）是否有图片？
我怎么能这样做？

Answer 1

您可以通过遍历工作表的 Shapes 集合来执行此操作，查找其.TopLeftCell 与您的目标范围具有相同地址的形状。

Answer 2

我有一种情况，我想从工作表上的选定单元格中删除图片（在我的案例图表中）并保留其他图片，因此删除所有图片不是一个选项。我留下了一些调试和一些额外的代码来告诉用户发生了什么。

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

最简单的解决方案是创建一个函数，如果图像存在于单元格中，则返回 1，否则返回 0。这仅适用于单个单元格，并且需要针对多单元格范围进行修改。

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

然后可以使用以下代码运行此代码：

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

这是一个相当老的帖子，所以不知道我的帖子是否会对任何人有所帮助，但我今天遇到了类似的问题，经过一番思考，得出了解决方案。

我首先将存在对象的所有范围地址存储到一个数组中，然后在代码的第二部分中，针对数组中的每个元素检查我选择的范围内的每个单元格地址以查找对象，并执行标记到如果数组元素地址与所选范围内的活动单元格地址匹配，则为偏移单元格。希望能帮助到你。代码如下：

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

Answer 6

Juhi 的方法帮助了我。我认为原始问题中隐含需要将其应用于多个单元格或连续范围甚至整个工作表。在这种情况下，最好不要单独考虑每个单元格，而是对所有感兴趣的单元格重复遍历工作表中的每个形状。

我稍微更改了功能以删除嵌套循环并将文本输入到包含形状的所有单元格中。这针对我的即时需求进行了优化，其中源数据是 4x40 单元格区域，其中单元格包含形状或根本不包含任何内容。我的方法不会为不包含形状的单元格输入“否”，但很容易将其输入到最后的空白单元格中。

Sub MarkCellsWithShapes()

    Dim rng As Range, shp As Shape, n As Integer, arr() As String, m As Integer, arrm As Variant

    n = ActiveSheet.Shapes.Count
    ReDim arr(n)
    
    m = 1

    For Each shp In ActiveSheet.Shapes
        arr(m) = shp.TopLeftCell.Address
        Range(arr(m)) = "Yes"
        m = m + 1
    Next

End Sub

如果您需要在特定范围内而不是整张纸上工作，您可以将“是”指令设为有条件的（请参阅VBA test if cell is in a range 以获取有关提示）。