Vb kodu sayfadaki butonları siliyor

[ugurex]

Merhabalar;
aşağıdaki kodu VBAProject(perpro.xlsm) > Microsoft Excel Objects > Sayfa1 (perpro) altına ekledim; C6 hücresindeki değere göre başka bir klasör altındaki resimleri çağırıyor; kod çalışıyor sorun yok fakat kod bir kez tetiklendiğinde sayfadaki butonları da siliyor, sayfada "sil", "yazdır" gibi butonlar var. 4.satırdan kaynaklandığını düşünüyorum, üstadların yardımına ihtiyacım var, ne yapabilirim?

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [c6]) Is Nothing Then Exit Sub
On Error Resume Next
ActiveSheet.DrawingObjects.Delete
Set fso = VBA.CreateObject("scripting.filesystemobject")
resimyolu = ThisWorkbook.Path & "\files\images\" & Range("c6") & ".jpg"
resimsiz = ThisWorkbook.Path & "\files\images\" & "resimyok.jpg"
If Not fso.fileexists(resimyolu) Then
  Set resimyok = ActiveSheet.Pictures.Insert(resimsiz)
   With Range("e7")
    resimyok.Top = Range("e7").Top
    resimyok.Left = Range("e7").Left
    resimyok.ShapeRange.LockAspectRatio = msoFalse
    resimyok.Height = 149
    resimyok.Width = 144
   End With
Else
  Set resim = ActiveSheet.Pictures.Insert(resimyolu)
  With Range("e7")
   resim.Top = Range("e7").Top
   resim.Left = Range("e7").Left
   resim.ShapeRange.LockAspectRatio = msoFalse
   resim.Height = 149
   resim.Width = 144
  End With
End If
End Sub

 

[muygun]

Merhaba;

ActiveSheet.DrawingObjects.Delete

satırını silin ve bunun yerine aşağıdaki satırları ekleyin.
Range ile belirtilen alanı kendinize göre düzenleyin.
İyi çalışmalar.


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

 

[ugurex]

Çok teşekkür ediyorum elinize sağlık, sorun çözüldü.