makro ile dosyadan resim çağırırken hatalı durum hk

[u.L.a.s]

merhabalar

aşağıdaki kod ile d sütununda d29 nolu hücrede yaptığım bir seçimle b29 hücresine resim getiriyorum. bu seçimi d30, d31,d32,d33 gibi ilerleyen hücrelerde devam ederek sırasıyla b30,b31b32,b33 hücrelerine resimler gelmiş oluyor.

fakat ben d sütununda bütün seçimleri yapmış ve resimleri çağırmış olayım. eğer d29 hücresinde sonrasında yaptığım seçimle bir resim tanılanmamış ve gelmiyorsa alt hücrelerdeki seçtiğim halde varolan resimler kayboluyor. tekrar d29 tanımlanmış bir resim çağırırsam alt hücredeki resimlerin hepsi görünmeye başlıyor. bu ufak sorunu nasıl alabilirim bilgi ve yardımlarınızı rica ederim

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [d:d]) Is Nothing Then Exit Sub
On Error GoTo çıkış
Dim ResimYolu As Variant
Dim resim As Object
ActiveSheet.DrawingObjects.Delete
For satır = 29 To 1000
ResimYolu = ActiveWorkbook.Path & "\" & Range("d" & satır) & ".jpg"
Set resim = ActiveSheet.Pictures.Insert(ResimYolu)

With Range("b" & satır)
resim.Top = .Top + 2
resim.Left = .Left + 4
resim.Height = .Height - 2
resim.Width = .Width - 4
End With
Next satır
çıkış:

End Sub

 

[Muzaffer Ali]

Merhaba.

On Error GoTo çıkış
Satırını, aşağıdaki satırın altına alın.
Set resim = ActiveSheet.Pictures.Insert(ResimYolu)

 

[u.L.a.s]

bu seferde "Set resim = ActiveSheet.Pictures.Insert(ResimYolu)" satırında hata verdi

 

[Orion1]

Önceki tüm resimleri silmek istiyorsanız;

Sub resimsilsil59()
Dim resim As Picture
For Each resim In ActiveSheet.Pictures
    resim.Delete
Next
End Sub

 

[halit3]

Kırmızı yerleri ekleyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [d:d]) Is Nothing Then Exit Sub
On Error GoTo çıkış
Dim ResimYolu As Variant
Dim resim As Object
ActiveSheet.DrawingObjects.Delete
For satır = 29 To 1000

ResimYolu = ActiveWorkbook.Path & "\" & Range("d" & satır) & ".jpg"

If CreateObject("Scripting.FileSystemObject").FileExists(ResimYolu) = True Then

Set resim = ActiveSheet.Pictures.Insert(ResimYolu)
With Range("b" & satır)
resim.Top = .Top + 2
resim.Left = .Left + 4
resim.Height = .Height - 2
resim.Width = .Width - 4
End With

End If

Next satır
çıkış:

End Sub

 

[u.L.a.s]

üstadlarım çok teşekkür ederim. halit3 üstadım ilettiğiniz kod düzenini uyguladığımda istediğim sonucu oldum harikasınız çok sağolun

 

[halit3]

üstadlarım çok teşekkür ederim. halit3 üstadım ilettiğiniz kod düzenini uyguladığımda istediğim sonucu oldum harikasınız çok sağolun

Teşekkürler iyi çalışmalar