Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("B2:B1000")) Is Nothing Or Target.Count > 1 Then Exit Sub
If Target <> "" Then
Dim Resim, adress, ResimAdi
On Error Resume Next
For Each Resim In ActiveSheet.Shapes
Resim.Delete
Next
For Each Resim In Sheets("Resimler").Shapes
adress = Resim.TopLeftCell.Column
If adress = 2 Then
ResimAdi = Sheets("Resimler").Cells(Resim.TopLeftCell.Row, 1).Value
If ResimAdi = Target Then
Resim.Copy
ActiveSheet.Paste Destination:=Cells(5, 10)
With Cells(5, 10)
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.Height = .MergeArea.Height - 4
Selection.Width = .MergeArea.Width - 4
Selection.Top = .Top + 2
Selection.Left = .Left + 2
Selection.Placement = xlMoveAndSize
End With
Target.Select
Exit Sub
End If
End If
Next
End If
End Sub