Makro düğmelerinin kaybolması

[akcayonline]

Merhaba, sayfaya eklediğim makro butonlar dosya açılıp kapanınca siliniyor. Bunu silinmesine neden olan durum ; başka bir makro ile sayfaya resim çağırıyorum , o makro da sayfa açılıp kapanınca mevcut resimi siliyor. Normalde diğer işlem için gerekli fakat sayfadaki tüm şekilleri silince olmadı. Resim silinen alanı kısıtladım ( Set Alan = Range("m1:O40") ) fakat yine olmadı. Makroyu nasıl düzenlerimde sadece M1:O40 arasındaki resim silinir , diğer şekiller silinmez ? desteğinizi rica ediyorum.

Şekillerin dosya kapatılıp açılınca silinmesini sağlayan kod ;

Public Function DosyaVarmi(dosyayolu As String) As Boolean
    On Error GoTo Çikis
    If Not Dir(dosyayolu, vbDirectory) = vbNullString Then DosyaVarmi = True
     
Çikis:
    On Error GoTo 0
End Function
 
'worksheette bir degisiklik oldugunda bu kisim çalisiyor
Private Sub Worksheet_Change(ByVal Target As Range)
 
'degisiklik b sutunundami olmus diye kontrol et, degilse direk olarak fonksiyondan çik
If Intersect(Target, [E5]) Is Nothing Then Exit Sub

Dim ResimDosyaYolu As String
Dim Resim As Object
Dim Resim_yolu
 
'herhangi bir hata olusursa Çikis labelina git
On Error GoTo Çikis:

'resimleri Sil
Set Alan = Range("m1:O40")
 For Each Resim In ActiveSheet.Pictures
        If Not Intersect(Resim.TopLeftCell, Alan) Is Nothing Then
            Resim.Delete
        End If
Next

'b deki 5 ile 12 arasindaki satirlari kontrol edip resim atamasi yapiyoruz, siz burayi isteginize göre artirabilirsiniz
'For i = 5 To 12
    'aktif sayfanin path bilgisini alip, seçilen ürün idyi sonuna ekliyoruz ve dosyayi aliyoruz
    ResimDosyaYolu = Resim_yolu & "\\orfs1\depo\Planlama\Desen_resimler\" & Range("e" & 5) & ".jpg"
 
    'dosya yok ise hataya düsmemek için asagidaki kontrolü yapiyoruz.
    If DosyaVarmi(ResimDosyaYolu) Then
         ResimDosyaYolu = Resim_yolu & "\\orfs1\depo\Planlama\Desen_resimler\" & Range("e" & 5) & ".jpg"
   Else
         ResimDosyaYolu = Resim_yolu & "\\orfs1\depo\Planlama\Desen_resimler\yok.jpg"
   End If
         
    'resmi olusturuyoruz.
     Set Resim = ActiveSheet.Pictures.Insert(ResimDosyaYolu)
     'Resmi boyutlandiriyoruz
     With Range("n9:o28")
     Resim.ShapeRange.LockAspectRatio = msoFalse
     Resim.Top = .Top
     Resim.Left = .Left
     Resim.Height = .Height
     Resim.Width = .Width
     End With
 
'Next i
Çikis:
End Sub

 

[Ömer BARAN]

Merhaba.

Umarım yanlış anlamadım.

Verdiğiniz kod'da bulunan Resim.Delete şeklindeki satırın yerine;
aşağıdaki gibi, silinmeyecek düğme/şekillerin adlarını ekleyip çıkartarak,
sadece ismi bunlardan biri olmayan resimlerin/şekillerin silinmesini sağlayabilirsiniz.
.

If Resim.Name <> "[COLOR="Red"]DÜĞME1[/COLOR]" And Resim.Name <> "[COLOR="red"]KAYDET[/COLOR]" And Resim.Name <> "[COLOR="red"]SİL[/COLOR]" Then _
    Resim.Delete