çalışma belgesinde resim koymak

[polis-53]

merhaba arkadaşlar aşağıda gönderdiğim koddaki işçi çalışma belgesinde fakat resmi istediğim yere taşıyamıyorum resmi istediğim yere nasıl koyabilirim yardımcı olursanız çok sevineceğim. arkadaşlar dosyayı gönderemedim.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Resim As OLEObject
Dim Yeni_Resim As OLEObject
Dim Adres As Range
Dim Dosya_Yolu As String
Dim Resim_Adı As String
If Intersect(Target, [C5]) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Dosya_Yolu = ThisWorkbook.Path & "\Resimler\"
Resim_Adı = Target.Value & ".jpg"
Set Adres = Range(Target.Offset(3, 7).Address, Target.Offset(-1, 6).Address)
If ActiveSheet.Shapes.Count > 5 Then
For Each Resim In ActiveSheet.OLEObjects
If Not Intersect(Range(Resim.TopLeftCell.Address & ":" & Resim.BottomRightCell.Address), Adres) Is Nothing Then
Resim.Delete
End If
Next
End If

If Dir(Dosya_Yolu & Resim_Adı) <> "" Then
Set Yeni_Resim = ActiveSheet.OLEObjects.Add(ClassType:="Forms.Image.1", Link:=False, _
DisplayAsIcon:=False, Left:=Adres.Left, Top:=Adres.Top, Width:=Adres.Width, Height:=Adres.Height)
With Yeni_Resim
.Top = Adres.Top
.Left = Adres.Left
.Height = Adres.Height
.Width = Adres.Width
.Object.PictureSizeMode = fmPictureSizeModeStretch
End With

Yeni_Resim.Object.Picture = LoadPicture(Dosya_Yolu & Resim_Adı)
Else
MsgBox "resim yok"
'Yeni_Resim.Object.Picture = LoadPicture(Dosya_Yolu & "Stok_Resmi_Yok.jpg")
End If
Application.ScreenUpdating = True
End Sub