vba dosyadan resim çekme

[snn38]

merhaba arkadaşlar
excel vba da yeni yeni kod yazıyorum
yazdığım kod
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [E2]) Is Nothing Then Exit Sub
On Error GoTo çıkış
ActiveSheet.DrawingObjects.Delete
Dim Resimyolu As Variant
Dim resim As Object
Resimyolu = ActiveWorkbook.Path & "\" & Range("E2") & ".jpg"
Set resim = ActiveSheet.Pictures.Insert(Resimyolu)
With Range("G10")
resim.Top = .Top
resim.Left = .Left
resim.Height = .Height
resim.Width = .Width
End With

çıkış:


End Sub


bu koddasıkıntım değişen resimlerin yanında başka resimlerde silinyor
ben sadece klasörden çektiğim resimlerin silinmesini istiyorum
yardımcı olursanız çok teşekkür ederim
herkesi iyi geceler.

 

[muygun]

Merhaba;
Kodlarınızı;

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [E2]) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
On Error GoTo çıkış

Set Alan = Range("G10")
For Each resimm In ActiveSheet.Pictures
If Not Intersect(resimm.TopLeftCell, Alan) Is Nothing Then
resimm.Delete
End If
Next
Set Alan = Nothing

Dim Resimyolu As Variant
Dim resim As Object
Resimyolu = ActiveWorkbook.Path & "\" & Range("E2") & ".jpg"
Set resim = ActiveSheet.Pictures.Insert(Resimyolu)
With Range("G10")
resim.Top = .Top
resim.Left = .Left
resim.Height = .Height
resim.Width = .Width
End With
Application.ScreenUpdating = True

çıkış:


End Sub

Şeklinde uygulayın.
İyi çalışmalar.

 

[snn38]

CEVAP VERDİĞİNİZ İÇİN TEŞEKKÜRLER

DİM RESİM AS OBJECT KISMINDA

duplicate declaration in current scope

hatası alıyorum

 

[muygun]

Merhaba;
Yaptığım uygulamada bir sorun göremedim.
İyi çalışmalar.

Link:
http://s9.dosya.tc/server2/uior04/snn38-rsm_getir.zip.html

 

[snn38]

gayretleriniz için teşekkür ederim kod çalışıyor elinize kolunuza sağlık