在Excel中,我想检查例如“C12”的特定单元格是否有图片?
我怎么能这样做?
答案 0 :(得分:7)
您可以循环浏览工作表的Shapes集合,查找.TopLeftCell
与目标范围具有相同地址的形状。
答案 1 :(得分: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
答案 2 :(得分: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
答案 3 :(得分:1)
For Each wShape In ActiveSheet.Shapes
If (wShape.Type <> 13) Then wShape.Delete ' If the shape doesn't represent a Picture, ' delete
Next wShape
答案 4 :(得分:1)
这是一个很老的话题,所以不知道我的文章是否对任何人都有帮助,但是我今天遇到了类似的问题,经过一番思考,得出了解决方案。
我首先将对象存在的所有范围地址存储到一个数组中,然后在代码的第二部分中,针对数组中的每个元素检查对象在我选择的范围中的每个单元格地址,并执行标记为如果数组元素地址与所选范围内的活动单元格地址匹配,则为偏移单元格。希望能帮助到你。这是代码:
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
答案 5 :(得分:0)
Juhi的方法帮助了我。我认为在原始问题中隐含需要将其应用于多个单元格或连续范围甚至整个工作表。在这种情况下,最好不要单独考虑每个单元格,并且对所有感兴趣的单元格重复遍历图纸中的每个形状。
我对功能进行了一些更改,以删除嵌套循环,并在所有包含形状的单元格中输入文本。这是针对我眼前的需要而优化的,其中源数据是4x40的单元格区域,其中的单元格包含Shape或根本不包含任何内容。对于没有形状的单元格,我的方法不会输入“ no”,但是很容易将其最后输入到空白单元格中。
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)。