vba - Excel VBA - 在 Worksheet_Change 事件上将图像插入工作表时出现问题

Question

我有两列:

     A         B
1    Animal    Picture
2    Lion      (Lion picture)
3    Ant       (Ant picture)

当我在新单元格中输入动物名称时(假设 A4 )，公式完美运行:我在图片列中得到图片( B )。

如果我删除列中的值 A (假设我删除了 Lion)然后 Lion 的图片被删除。

但是当我手动编辑而不删除 A2 中的值时，新图片重叠 B2在最后一个之上。当我删除 A2值，只删除最新的图片。我必须再次删除空单元格 A2删除单元格中的剩余图片 B2 .

有没有办法解决这个问题？

这是我目前的 Worksheet_Change事件代码:

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo son
    If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
    If Target.Row Mod 20 = 0 Then Exit Sub

    If Not IsEmpty(Target) Then '<--| if changed cell content is not empty
        With Pictures.Insert(ThisWorkbook.Path & "\" & Target.Value & ".png")
            .Top = Target.Offset(0, 2).Top
            .Left = Target.Offset(0, 1).Left
            .ShapeRange.LockAspectRatio = msoFalse
            .ShapeRange.Height = Target.Offset(0, 2).Height
            .ShapeRange.Width = Target.Offset(0, 2).Width
            .Name = Target.Address '<--| associate the picture to the edited cell via its address
        End With
    Else '<--| if cell content has been deleted
        Me.Shapes(Target.Address).Delete '<--| delete the picture whose name is associated to the cell via its address
    End If
    Target.Offset(1, 0).Select
son:
End Sub

Answer 1

我同意@RCaetano 的评论:

...maybe you should always (and before doing anything) delete the picture related to the cell you are editing.

如果您遵循此建议，那么您将不会遇到重叠图像的问题。如果 A2包含“狮子”；您手动编辑单元格并重新输入“Lion”，那么您将面临删除和重新插入同一图像的一小部分开销 - 但这是比您目前拥有的更好的结果。
Worksheet_Change代码可以是:

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo son

    Application.ScreenUpdating = False
    If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
    If Target.Row Mod 20 = 0 Then Exit Sub

    'remove the picture
    Dim shp As Shape
    For Each shp In Me.Shapes
        If shp.Name = Target.Address Then
            Me.Shapes(Target.Address).Delete
            Exit For
        End If
    Next

    'add a picture of the text that was entered
    If Not IsEmpty(Target) Then '<--| if changed cell content is not empty
        With Pictures.Insert(ThisWorkbook.Path & "\" & Target.Value & ".png")
            .Top = Target.Offset(0, 2).Top
            .Left = Target.Offset(0, 1).Left
            .ShapeRange.LockAspectRatio = msoFalse
            .ShapeRange.Height = Target.Offset(0, 2).Height
            .ShapeRange.Width = Target.Offset(0, 2).Width
            .Name = Target.Address '<--| associate the picture to the edited cell via its address
        End With
    End If
    Target.Offset(1, 0).Select
    Application.ScreenUpdating = True

son:
    Application.ScreenUpdating = True
End Sub