Mar 27 2022 11:36 PM
Mar 27 2022 11:36 PM
I have a VBA code (see below) to insert a picture from folder located in My Computer. The code can insert the intended pictures however I have a problem that It keeps inserting the pictures when ever I make change or reopen the excel file.
I use this formula to insert in a specific cell ("=InsertPicFromURL(VLOOKUP(A11,Pictures,3))"), to call the Picture's location in A11 (Pictures' URL)
When ever the content of A11 is changes I want it to DELETE the previous Picture and insert new one as per the value in A11.
However, it keeps the previous Picture and inserts New and again If I make any change or save and reopen it will keep on inserting Picture.
How can I resolve this please?
Mar 28 2022 03:37 AM
Remove the formula(s).
Right-click the sheet tab.
Select 'View Code' from the context menu.
Copy the code listed below into the worksheet module.
I have used A11:A20 as the range of cells that should trigger inserting a picture. Change this as needed.
And I have used column D for the pictures. Also change this as needed.
Switch back to Excel.
Save the workbook as a macro-enabled workbook (*.xlsm).
Make sure that you allow macros when you open it.
Private Sub Worksheet_Change(ByVal Target As Range) Dim rng1 As Range Dim rng2 As Range Dim cel As Range Dim pic As Picture Dim url As Variant ' Look for cells in A11:A20 that have been changed Set rng1 = Intersect(Range("A11:A20"), Target) If rng1 Is Nothing Then Exit Sub Application.ScreenUpdating = False ' Pictures are in column D (3 columns to the right of column A) Set rng2 = rng1.Offset(0, 3) ' Delete all pictures in rng2 For Each pic In Me.Pictures If Not Intersect(pic.TopLeftCell, rng2) Is Nothing Then pic.Delete End If Next pic ' Loop through the changed cells For Each cel In rng1 If cel.Value <> "" Then url = Application.VLookup(cel.Value, Range("Pictures"), 3, False) If Not IsError(url) Then With Me.Pictures.Insert(url) .Top = cel.Top + 1 .Left = cel.Left + 1 .Height = Application.Max(cel.Height, cel.Width) + 2 .Width = Application.MaxC(cel.Width, .Width) + 2 End With End If End If Next cel Application.ScreenUpdating = True End Sub