tek kod, 2 farklı hücre, 2 farklı resim

[euphrates55]

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Dim resim As Object, i As Long, yol As String, dosya As String
Sheets("kooro").Select
yol = ThisWorkbook.Path & "\haritalar\"

Rem aralıktaki resmi sil
Set alan = Range("c5:K17")
For Each resimm In ActiveSheet.Pictures
If Not Intersect(resimm.TopLeftCell, alan) Is Nothing Then
resimm.Delete
End If
Next
Set alan = Nothing
Rem silme işleminin sonu

If Dir(yol & "\" & Cells(1, "V").Value & ".png") <> "" Then
dosya = "\" & Cells(1, "V").Value & ".png"
If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
Set P = ActiveSheet.Pictures.Insert(yol & dosya)
With Cells(5, "c")
t = .Top
l = .Left
W = .Offset(50, .Columns.Count).Left - .Left
h = .Offset(.Rows.Count, 50).Top - .Top
End With
With P
.Top = t + 5
.Left = l + 10
.Width = W - 10
.Height = h - 10
End With
Set P = Nothing
End If

Set s = Sheets("kooro")
If s.[c25] >= 0 And s.[c25] < 400 Then
s.[c21].Font.Name = "Palatino Linotype"
s.[c21].Font.Size = 24
ElseIf s.[c25] >= 401 And s.[c25] < 5000 Then
s.[c21].Font.Name = "Palatino Linotype"
s.[c21].Font.Size = 25
ElseIf s.[c25] >= 5001 Then
s.[c21].Font.Name = "Palatino Linotype"
s.[c21].Font.Size = 6
End If

End Sub

günaydınlar... bu kod ile c5:k17 hücresine resim ekliyorum. çok da güzel oluyor. (hücreye tam oturmasa da) peki aynı anda c19:q19 hücresine yol = ThisWorkbook.Path & "\KROKİLER\" dosyasından resim ekletmek istersem kod nasıl olmalı. ekleme yapmaya çalıştım fakat ilk resim de eklenmez oldu.

bir diğer sorum; bu kodda bir komut olmalı ki; kooro sayfasında bir hücreye, herhangi bir yere veri girişi yaptığımda geri al tuşu aktifliğini yitiriyor. onu da bulamadım.