Dears, I'm working in a sheet where i need to insert to 2 images from my folder on pc desktop to two different cells "D44" based on value in cell "E5" & other image in "J44" based on the value on cell "G5" I have a code but it only inserts one image to one cell and i need to repeat it to insert the 2nd image in "J44" if there is a value in its related cell G5 can you help me to make the code repeat again and check for the other cell or to edit it to include both of them in one process my images source on pc is: "D:\Desktop\Guards\Guards National IDs"
and here is my code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim picname As String
Dim pic As Object
Dim source As String
Dim t, l, h, w As Integer
source = Range("D44").Value
picname = "Picture 2"
Set pic = ActiveSheet.Shapes(picname)
With pic
t = .Top
l = .Left
h = .Height
w = .Width
End With
ActiveSheet.Shapes(picname).Delete
Set pic = ActiveSheet.Shapes.AddPicture(source, False, True, l, t, w, h)
pic.Name = picname
End Sub
please need to make the code repeat itself for the other cell or to modify it to do both process
Create a sub in a normal module called replaceImage
Public Sub replaceImage(cSource As Range, PicName As String)
Const pathPictures As String = "D:\Desktop\Guards\Guards National IDs\"
Dim filename As String 'maybe you have to add the file extension
filename = cSource.Value
Dim ws As Worksheet
Set ws = cSource.Parent
Dim oldPicture As Shape
Set oldPicture = ws.Shapes(PicName)
Dim newPicture As Shape
With oldPicture
Set newPicture = ws.Shapes.AddPicture(pathPictures & filename, False, True, _
.Left, .Top, .Width, .Height)
End With
oldPicture.Delete
newPicture.Name = PicName
End Sub
You can then call this sub from the worksheet_change event like this:
IMPORTANT Adjust the Case statements to your needs!!!
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim PicName As String
Select Case Target.Address
Case "$E$5"
PicName = "Picture 2"
Case "$G$5"
PicName = "Picture 3"
End Select
If PicName <> "" Then
replaceImage Target(1, 1), PicName
End If
End Sub