Excel VBA – 将图像插入Worksheet_Change事件的工作表时出现问题

我有两列：

AB 1 Animal Picture 2 Lion (Lion picture) 3 Ant (Ant picture) 

当我在一个新的单元格中键入一个动物的名字（可以说A4 ）时，该公式完美地工作：我在图片列（ B ）中得到图片。

如果我删除图A的值（可以说我删除了狮子），那么狮子的图片被删除。

但是，当我手动编辑而不删除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的评论：

…也许你应该总是（在做任何事之前）删除与你正在编辑的单元格相关的图片。

如果你遵循这个build议，那么你将不会面对重叠图像的问题。 如果A2包含“狮子”， 你手动编辑单元格并重新input“狮子”，那么你将面临删除和重新插入相同的图像一个小的开销 – 但这是一个比你目前有更好的结果。

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