Excel VBA - Ausgabe als Bild einfügen auf Worksheet_Change Ereignisse Arbeitsblatt

Question

Ich habe zwei Spalten:

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

Wenn ich ein Tier Namen in einer neuen Zelle eingeben (können sagen, A4), die Formel funktioniert perfekt: Ich erhalte das Bild in der Bildspalte (B).

Wenn ich einen Wert in cloumn A lösche (sagen wir lösche Lion), dann wird das Bild von Lion gelöscht.

Aber wenn ich manuell bearbeiten, ohne Wert in A2 zu löschen, überlappt ein neues Bild B2 über dem letzten. Wenn ich den Wert A2 lösche, wird nur das letzte Bild gelöscht. Ich muss wieder leere Zelle A2 löschen, um das verbleibende Bild in Zelle B2 zu löschen.

Gibt es eine Möglichkeit, dieses Problem zu beheben?

Hier ist meine aktuelle Worksheet_Change Ereigniscode:

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

ich mit dem Kommentar von @RCaetano einig, dass:

... vielleicht sollten Sie immer (und vor etwas zu tun) löschen die Bild in Bezug auf die Zelle, die Sie bearbeiten.

Wenn Sie diesen Rat befolgen, werden Sie das Problem überlappender Bilder nicht haben. Für den Fall, dass A2 "Lion" enthält; Sie bearbeiten die Zelle manuell und geben "Lion" erneut ein. Sie haben dann einen kleinen Aufwand, das gleiche Bild zu löschen und erneut einzufügen - aber das ist ein besseres Ergebnis als Sie derzeit haben.

Das könnte Worksheet_Change Code sein:

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