Excel的VBA - 插入圖像到工作表上Worksheet_Change事件，當問題

Question

我有兩列：

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

當我在一個新的單元格中鍵入一個動物名稱（可以說A4），式中完美的作品：我得到圖片欄中的圖片（B）。

如果我刪除了一個值cloumn 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的評論表示贊同：

...也許你應該總是（和做任何事情之前）刪除與正在編輯的單元格相關的圖片。

如果你遵循這個建議，那麼你將不會面臨重疊圖像的問題。如果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