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

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

---

我怎样才能做到这一点？

您可以通过在工作表的“形状”集合中循环，查找其

.TopLeftCell

与您的目标范围具有相同地址的形状来做到这一点。

针对ActiveSheet.Shapes中的每个wShape
For Each wShape In ActiveSheet.Shapes
If (wShape.Type <> 13) Then wShape.Delete ' If the shape doesn't represent a Picture,     ' delete
Next wShape

如果（wShape.Type 13），则wShape.Delete“如果形状不代表图片，则删除”
下一个形状

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

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

---

最简单的解决方案是创建一个函数，如果单元格中存在图像，则返回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

---

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

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

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

选项显式
子标记（）
Dim rng作为范围，shp作为形状，n作为整数，arr（）作为字符串，m作为整数，arrm作为变量
m=1
n=ActiveSheet.Shapes.Count
雷迪姆雷达（n）
对于ActiveSheet.Shapes中的每个shp
arr（m）=shp.TopLeftCell.Address
m=m+1
下一个
对于选择中的每个rng
m=1
对于arr中的每个arrm
如果rng.Address=arr（m），则
rng.偏移量（0,30）。Value=“是”
退出
其他的
rng.Offset（0,30）。Value=“否”
如果结束
如果m

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

---

如果您需要在特定范围而不是整个工作表中工作，您可以将“是”指令设置为有条件的（有关提示，请参阅）。

是否可以检查该形状是图片还是图标？因为形状有多种类型，所以也有更直接的方法，使用单元格并检查图片。

.Type

属性提供类型。请在IDE中按F2键并检查对象模型。我从未对这个问题给出过新的答案，但在对象浏览器中查找它花了我10秒钟。这无法正常工作（当范围内最多有1张图片时除外），当删除时，必须从末尾开始，并转到第一个

，因为I=ActiveSheet.Shapes.count到1步-1

。函数需要是布尔函数，当你需要从activesheet.shapes.count开始向后删除时，为了速度和正确回答（如果shapes集合中的下一张图片是不允许的，该函数将回答0），在你找到一张图片后的退出函数将受到重视。同样，对于这个目标，一个简单的

ascivesheet.pictures.delete将在一行中完成