[在Excel中,我想检查例如“ C12”的特定单元格是否有图片?我该怎么办?
您可以通过遍历工作表的Shapes集合,查找其.TopLeftCell
与目标范围的地址相同的形状来进行此操作。
我有一种情况,我想从工作表上选定的单元格中删除图片(在我的情况下为图表),而其他图片留在原处,因此删除所有图片是不可行的。我已经进行了一些调试,还留下了一些额外的代码来告诉用户正在发生的事情。
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
For Each wShape In ActiveSheet.Shapes
If (wShape.Type <> 13) Then wShape.Delete ' If the shape doesn't represent a Picture, ' delete
Next wShape
这是一个很老的话题,所以不知道我的文章是否对任何人都可以帮助,但是我今天遇到了类似的问题,经过一番思考,得出了解决方案。
我先将对象存在的所有范围地址存储到一个数组中,然后在代码的第二部分中,针对数组中的每个元素检查对象在我选择的范围内的每个单元格地址,并执行标记为如果数组元素地址与所选范围内的活动单元格地址匹配,则偏移单元格。希望能帮助到你。这是代码:
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