Koruma Kodu

[nurluali]

İyi Akşamlar Diliyorum.
Private Sub Worksheet_Change(ByVal Target As Range)

Application.EnableEvents = False

If Not Intersect(Target, A2:KY2,B3:C35,J3:J35,N3:N35,R3:R35,W3:W35,AH3:AI35,AQ3:AS35,AW3:AW35,BB3:BB35,BE3:BE35,BI3:BI35,BL3:BL35,BP3:BP35,BS3:BS35,BU3:BU35,BW3:BX35,BZ3:BZ35]) Is Nothing Then

If sifre = False Then

'c = InputBox("Şifre yazınız. (şifre : 133 )", "Onay şifresi")

If c <> 123 Then

Application.Undo

Else

sifre = True

End If

End If

End If

Application.EnableEvents = True

End Sub

',BB3:BB35,BE3:BE35,BI3:BI35,BL3:BL35,BP3:BP35,BS3:BS35,BU3:BU35,BW3:BX35,BZ3:BZ35,CD3:CD35,CM3:CN35,CS3:CS35,DA3A35,DD3D35,DG3H35'

SORU 1- Emir Hüseyin ÇOBAN Beyin yazdığı bir koruma kodu . Bu Kod ile 50-60 Farklı sutünları korumak istyiyorum. Fakat yukarıda kırmızı renkli kısımlara kadar sorunsuz çalışıyor. Sutun Sutün KY 'ye kadar farklı sutunlarda çalışmıyor. Daha önce denedim derleme hatası verdi. Kodda bir değişiklik yapılabiri mi? veya Başka bir öneri var mı?

SORU-2 Ömer BARAN Bey'in Hazırladığı Aşağıdaki Kodla birlikte çalışabilir mi?

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)

Cells.Interior.ColorIndex = xlColorIndexNone

ActiveCell.EntireColumn.Interior.ColorIndex = 34 'Sütun Rengi

ActiveCell.EntireRow.Interior.ColorIndex = 36 ' Satır Rengi

ActiveCell.Cells.Interior.ColorIndex = 6 ' Hücre Rengi

End Sub
Korumak İstediğim sutünlar RAM Sayfasındaki renkli sutünlardır. Örnek Dosya Sayfa1 de yukarıdaki açıklama mevcut

 

[Ömer BARAN]

Merhaba.

Mevcut kodları bir kenara bırakıp, isteğinizi net ifade ederseniz daha hızlı sonuca ulaşacağınızı düşünüyorum.
Korumak istediğiniz sütunların bir ortak noktası var mıdır ?

-- Belgedeki koşullu biçimlendirme işleminde "BAŞLIK" kelimesi kriter olarak kullanılmış durumda.
Asıl belgede uygulamak istediğiniz işlem için aynı kural kullanılabilir mi?
-- Ya da ilgili sütunların sütun numaraları arasında bir ritim, matematiksel ilişki, örüntü vs. var mıdır?
.

 

[nurluali]

Hayır Sadece biçimlendirmeyi başlık olduğu belirli olsun diye yapmıştım sadece ilgili sütunları koruma yapılırsa biçimlendirmeye de gerek kalmaz. çok sayıda sütun olduğu için doldurma sırasında silinmemesi esas amaç. Teşekkür ediyorum Ömer Bey ikinci kod sizin hazırladığınız bir kod birlikte çalışmıyor.

 

[Ömer BARAN]

Konu açılış mesajınızı zaten okudum.
Ama siz sorduğum hususlarla ilgili cevap yazmamışsınız.

 

[nurluali]

İstediğim sadece A2:KY2 Başlığındaki bilgiler ve Başlık Yazan Renkli stunlar

 

[nurluali]

İlgili sütunlara başlık Koşullu biçimlendirmede olduğu gibi BAŞLIK olarak geçen ifadelerin korunması gibi birşey olabilir mi?

 

[Ömer BARAN]

Yanlış anlamıyorsam; belgenizde mevcut Worksheet_Change kod blokunu tamamen silip, yerine aşağıdaki kod blokunu yapıştırın.
Aşağıdaki kod; sayfada bir hücreye veri yazıldığında, bu hücrenin bulunduğu sütunun 2'nci satırındaki metin içerisinde BAŞLIK ibaresi
geçiyorsa, şifre ekranı gelir, şifre yanlışsa, yazılan değer silinir, doğruysa zaten mesele yok.
İlgili sütundaki 2'nci satır metninde BAŞLIK ibaresi yoksa kod aktif hale gelmez.

Private Sub Worksheet_Change(ByVal Target As Range)
If Len(Replace(Cells(2, Target.Column), "BAŞLIK", "")) <> Len(Cells(2, Target.Column)) Then
    Application.EnableEvents = False
    If sifre = False Then
        c = InputBox("Şifre yazınız. (şifre : 133 )", "Onay şifresi")
        If c <> 123 Then
            Application.Undo
        Else
            sifre = True
        End If
    End If
    Application.EnableEvents = True
End If
End Sub

 

[nurluali]

Teşekkür Ediyorum Ömer Bey Elinize Sağlık. Şifreyi tırnakla etkisiz hale getirirsem tamam olur galiba. Tekrar Teşekkür eder iyi akşamlar dilerim.

 

[nurluali]

Kodu esas belgeme uyguladım şöyle bir sorun çıktı silmeyi engelliyor faka sağa doğru doldurma yaptığımda başlık ifadesi yerine doldurduğum kelime geliyor. yeni kelimeyi de silmeyi engelliyor.