Excel VBA：点击图片时删除前一张图片的实现问题求助

你现在的代码是在加载新图片前自动删除H10:R24区域内的旧图，但这和你想要的「点击图片时删除前一张」的需求不匹配。要实现点击图片触发删除操作，需要给每张新加载的图片绑定点击事件，具体步骤如下：

1. 调整图片加载逻辑，给图片做标记 #

加载新图时，先给已有的旧图打标记，再插入新图并绑定点击宏：

Private Sub ShowValues()
    Dim Var As String
    Dim Var2 As String
    Dim insert_path As String
    Dim newPic As Shape
    Dim oldPic As Shape
    
    ' 给当前区域内的旧图标记为"OldPic"
    For Each oldPic In ActiveSheet.Shapes
        If Not Application.Intersect(oldPic.TopLeftCell, Range("H10:R24")) Is Nothing Then
            oldPic.Name = "OldPic"
        End If
    Next oldPic
    
    Range("C1").Value = ActiveCell.Value
    Var = "********" ' 替换成你的实际文件路径
    Var2 = Range("C1").Value
    insert_path = Var & "\" & Var2
    
    ' 插入新图并标记为"NewPic"，同时绑定点击宏
    Set newPic = ActiveSheet.Shapes.AddPicture(insert_path, _
      msoCTrue, msoCTrue, 400, 160, 800, 600)
    newPic.Name = "NewPic"
    newPic.OnAction = "DeleteOldPicture"
End Sub

2. 编写点击触发的删除宏 #

在Excel的模块里添加以下代码，点击新图时就会删除标记好的旧图：

Sub DeleteOldPicture()
    Dim oldPic As Shape
    ' 找到标记为"OldPic"的图片并删除
    For Each oldPic In ActiveSheet.Shapes
        If oldPic.Name = "OldPic" Then
            oldPic.Delete
            Exit For ' 找到旧图就停止遍历，提高效率
        End If
    Next oldPic
End Sub

备选方案：按创建时间判断先后 #

如果不想用名称标记，也可以通过图片的创建时间来识别前一张图，点击时删除更早创建的那张：

Sub DeletePreviousPicture()
    Dim currentPic As Shape
    Dim targetPic As Shape
    Dim earliestTime As Date
    
    ' 获取当前被点击的图片
    Set currentPic = ActiveSheet.Shapes(Application.Caller)
    earliestTime = currentPic.CreationDate
    
    ' 遍历找到区域内创建时间更早的图片并删除
    For Each targetPic In ActiveSheet.Shapes
        If Not Application.Intersect(targetPic.TopLeftCell, Range("H10:R24")) Is Nothing Then
            If targetPic.CreationDate < earliestTime Then
                targetPic.Delete
                Exit For
            End If
        End If
    Next targetPic
End Sub

用这个方案的话，把加载图片代码里的newPic.OnAction = "DeleteOldPicture"改成newPic.OnAction = "DeletePreviousPicture"就行。

内容的提问来源于stack exchange，提问作者Tricky5