Sayfa Koruma Kullanmadan Hücre Koruma

[fthtls]

Arkadaşlar merhaba,

"Sayfa Koruma" seçeneğini hiç kullanmadan çalışma sayfamdaki A1 hücresinin değiştirilmesini, silinmesini, kesilmesini vb. engellemek, bu seçeneklerin kullanılabilmesi içinde şifre istenmesini sağlamak istiyorum. Bunun için kullanabileceğim bir makro var mı?

Yardımcı olanlara şimdiden teşekkürler.

 

[Korhan Ayhan]

Merhaba,

Ekteki örnek dosyayı incelermisiniz.

Tüm kontrolleri yapamadım. Belki gözümden kaçan noktalar vardır. Belirtirseniz düzeltmeye çalışırım.

Kullanılan kodlar;

Sayfanın kod bölümüne uygulayın

Option Explicit
 
Private Sub Worksheet_Activate()
    Range("A2").Select
End Sub
 
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Row = 1 Or Target.Column = 1 Then Cancel = True
End Sub
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim Onay
    If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub
    Onay = Application.InputBox("Bu hücrede işlem yapmak için şifrenizi giriniz!")
    Select Case Onay
        Case False
            MsgBox "İşleminiz iptal edilmiştir!", vbExclamation
            Target.Next.Select
            Exit Sub
        Case ""
            MsgBox "Hatalı şifre!", vbCritical
            Target.Next.Select
            Exit Sub
        Case 12345
            MsgBox "Bu hücrede işlem yapabilirsiniz.", vbInformation
    End Select
End Sub

ThisWorkbook bölümüne uygulayın.

Option Explicit
 
Private Sub Workbook_Open()
    Sheets("Sayfa1").Select
    Range("A2").Select
End Sub

 

[fthtls]

Öncelikle vakit ayırdığınız için teşekkürler. Örnek dosyanızı inceledim. Ancak şöyle bir problem var. Şifre yanlış girilse dahi hücre içeriği değiştirilebiliyor.

 

[chakkal]

bilgilendirme için teşekkürler

 

[fthtls]

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Onay
Dim Sifre
Sifre = "12345"
If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub
Onay = Application.InputBox("Bu hücrede işlem yapmak için şifrenizi giriniz!")
Select Case Onay
Case False
MsgBox "İşleminiz iptal edilmiştir!", vbExclamation
Target.Next.Select
Exit Sub
Case Is <> Sifre
MsgBox "Hatalı şifre!", vbCritical
Target.Next.Select
Exit Sub
Case Is = Sifre
MsgBox "Bu hücrede işlem yapabilirsiniz.", vbInformation
End Select
End Sub

Kodu yukarıdaki gibi revize ettim. Sorun çözüldü. Yardımınız için çok teşekkürler.