CODEWITHSUNDEEP
vbaexcel
Sewak Tamang
Sewak Tamang

Reputation: 31

Excel VBA - Issue when inserting image to worksheet on Worksheet_Change event

I have two columns:

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

When I type an animal name in a new cell (lets say A4), the formula works perfectly: I get the picture in the picture column (B).

If I delete a value in cloumn A (lets say I delete Lion) then the picture of Lion gets deleted.

But when I edit manually without deleting value in A2, a new picture overlaps B2 above the last one. When I delete that A2 value, only the latest picture get deleted. I have to delete again empty cell A2 to delete remaining picture in cell B2.

Is there any way to fix this issue?

Here is my current Worksheet_Change event code:

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

Upvotes: 2

Views: 645

Answers (1)

Robin Mackenzie
Robin Mackenzie

Reputation: 19289

I agree with the comment by @RCaetano that:

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

If you follow this advice then you will not face the problem of overlapping images. In the event that A2 contains 'Lion'; you manually edit the cell and re-enter 'Lion' then you will face a small overhead of deleting and re-inserting the same image - but this is a better outcome than you currently have.

The Worksheet_Change code could be:

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

Upvotes: 1

Related Questions