如何檢查單元格是否有圖片？

Question

在 Excel 中，我想檢查例如“C12”的特定單元格是否有圖片？
我怎么能這樣做？

Answer 1

為此，您可以循環訪問工作表的 Shapes 集合，查找.TopLeftCell與目標范圍具有相同地址的形狀。

Answer 2

最簡單的解決方案是創建一個函數，如果單元格中存在圖像，則返回 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 3

我有一種情況，我想從工作表上的選定單元格中刪除圖片（在我的案例圖表中）並將其他單元格留在原地，因此刪除所有圖片不是一個選項。 我留下了一些調試和一些額外的代碼來告訴用戶發生了什么。

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 4

這是一個很老的帖子，所以不知道我的帖子是否對任何人有幫助，但我今天遇到了類似的問題，經過一些思考，得出了解決方案。

我首先將對象存在的所有范圍地址存儲到一個數組中，然后在代碼的第二部分中，根據數組中的每個元素檢查對象的所選范圍中的每個單元格地址，並執行對偏移單元格的標記如果數組元素地址與所選范圍內的活動單元格地址匹配。 希望能幫助到你。 這是代碼：

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 5

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 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 測試是否單元格在范圍內以獲取有關提示）。