如何動態地根據單元格值

Question

我有兩個柱

A   B 

Cat 
Lion 

圖片是c:\pictures文件夾，並且在png format.I已經寫了這樣的代碼

Private Sub Worksheet_Change(ByVal Target As Range) 
If Intersect(Target, [A:A]) Is Nothing Then Exit Sub 
If Target.Row Mod 20 = 0 Then Exit Sub 
On Error GoTo son 
ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & Target.Value & ".jpg").Select 
Selection.Top = Target.Offset(0, 2).Top 
Selection.Left = Target.Offset(0, 4).Left 
Selection.ShapeRange.LockAspectRatio = msoFalse 
Selection.ShapeRange.Height = Target.Offset(0, 2).Height 
Selection.ShapeRange.Width = Target.Offset(0, 2).Width 
Target.Offset(1, 0).Select 
son: 

End Sub 

公式作品中插入圖像精細。但是當我刪除A2或A3的值時，相應的Picutres沒有被刪除。當我再次在A2和A3中寫入項目時，圖片將添加上面的舊圖片。

如果單元格A2和A3的值爲空，那麼還有什麼方法可以刪除圖片嗎？

Answer 1

編輯添加/刪除前處理圖片不存在/存在

，這樣可以很容易地引用它們，一旦你刪除一些父單元格的內容，你能說出其父單元格地址的圖片：

Private Sub Worksheet_Change(ByVal target As Range) 
    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 
     If Not IsPicture(target) Then '<--| if there's not a picture whose name matches the target address 
      With Pictures.Insert("C:\Users\chojwa\Desktop\a\UT\VARIE\software\VBA programming\Forum\Stack Overflow\images" & "\" & target.Value & ".bmp") '<--| insert it 
       .Top = target.Offset(0, 2).Top 
       .Left = target.Offset(0, 4).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 
    Else '<--| if cell content has been deleted 
     If IsPicture(target) Then Me.Shapes(target.Address).Delete '<--| delete the picture whose name is associated to the cell via its address, if any 
    End If 
    target.Offset(1, 0).Select 
son: 
End Sub 

Function IsPicture(target As Range) As Boolean 
    On Error Resume Next 
    IsPicture = Not Shapes(target.Address) Is Nothing 
    On Error GoTo 0 
End Function