使用vba从单元格中删除图片

Question

我想使用宏在单元格中复制新图片但在复制新图片之前如何检查已经有图片的特定单元格，与当前单元格匹配 shape.TopLeftCell 不工作对我来说，非常感谢任何帮助！

' this is not working for every picture
Sub DeleteCell(curcell) 'curcell=ActiveWindow.ActiveCell

Dim sh As Shapes

For Each sh In ActiveSheet.Shapes
    If sh.TopLeftCell.Address = curcell.Cells.Address Then
         sh.Delete
    End If
Next

End Sub

由于

Answer 1

1. 将Sub DeleteCell(curcell)更改为Sub DeleteCell(curcell As Range)
2. 将Dim sh As Shapes更改为Dim sh As Shape
3. 将curcell.Cells.Address更改为curcell.Address

所以你的代码看起来像这样

Sub DeleteCell(curcell As Range)  'curcell=ActiveWindow.ActiveCell
    Dim sh As Shape

    For Each sh In ActiveSheet.Shapes
        If sh.TopLeftCell.Address = curcell.Address Then sh.Delete
    Next
End Sub

Answer 2

如果需要，您可以使用以下代码：

Sub deleteImage()
    Dim Pict As Shape
    Dim Cel As Range
    Set Cel = Sheets("Sheet1").Range("F12")
    Dim Caddress As String
    Caddress = Cel.Address
    For Each Pict In Sheets("Sheet1").Shapes 'Check for each picture in the range
        If Pict.Type = msoPicture Then
            If Pict.TopLeftCell.Address = Caddress Or Pict.BottomRightCell.Address = Caddress Then
                Pict.Delete
                Exit Sub
            Else:
                MsgBox "Doesn't exists a picture in the range"
                Exit Sub
            End If
        End If
    Next Pict
End Sub