Soru Belirli Hücreleri Kilitleme

[TURKOLOG]

Herkese merhaba
Makro ile
"VERİ ALANI 1" ; "VERİ ALANI 2" ,
"VERİ ALANI 3" sayfalarınin
E5 E7 E8 E9 E10
F17 F18 F19
E27 E28 E29
E40 E41 E42 E43 E44
G11 G14 G17
K1 K2 K3 K4 K5
L3 L23 hücrelerinin kilitlenmesi ve bu hücrelerin kikitlerinin kalkması için bir koda ihtiyacım var. Ama makro project ve unproject yaparken mutlaka şifre sorsa yetkisiz kullanım için. Yardım edebilecek olan var mı acaba

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Sayfalari_Koru()
    Dim Sayfa As Variant, Sayfalar As Variant, Sh As Worksheet, Alan As Range, Onay As Variant
    
    Onay = Application.InputBox("İşlem için şifrenizi giriniz.")
    
    If Onay = "12345" Then
        Sayfalar = Array("VERİ ALANI 1", "VERİ ALANI 2", "VERİ ALANI 3")
        
        For Each Sayfa In Sayfalar
            Set Sh = Worksheets(Sayfa)
            With Sh
                .Unprotect "+++"
                Set Alan = Union(.Range("E5,E7:E10"), .Range("F17:F19"), .Range("E27:E29"), _
                           .Range("E40:E44"), .Range("G11,G14,G17"), .Range("K1:K5"), .Range("L3,L23"))
                .Cells.Locked = False
                 Alan.Locked = True
                .Protect "+++"
            End With
        Next
        MsgBox "Sayfalar korumaya alınmıştır.", vbInformation
    Else
        MsgBox "Hatalı şifre girişi yaptığınız için işleminiz iptal edilmiştir.", vbCritical
    End If
End Sub

Sub Sayfalarin_Korumasini_Kaldir()
    Dim Sayfa As Variant, Sayfalar As Variant, Sh As Worksheet, Onay As Variant
    
    Onay = Application.InputBox("İşlem için şifrenizi giriniz.")
    
    If Onay = "12345" Then
        Sayfalar = Array("VERİ ALANI 1", "VERİ ALANI 2", "VERİ ALANI 3")
        
        For Each Sayfa In Sayfalar
            Set Sh = Worksheets(Sayfa)
            With Sh
                .Unprotect "+++"
            End With
        Next
        MsgBox "Sayfa korumaları kaldırılmıştır.", vbInformation
    Else
        MsgBox "Hatalı şifre girişi yaptığınız için işleminiz iptal edilmiştir.", vbCritical
    End If
End Sub

 

[TURKOLOG]

Sayın @Korhan Ayhan çok teşekkür ederim. Elinize emeğinize sağlık.
Bir sorum daha olacaktı. aynı mantıkla şifre girerek
VERİ ALANI 1" ; "VERİ ALANI 2" ,
"VERİ ALANI 3" sayfalarınin
K1 K2 K3 K4 K5
L1 L7 L9
M5 M16
satırlarını tek kodla temizlemek istersem Nasıl yapabilirim.

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Sayfalardaki_Hucreleri_Temizle()
    Dim Sayfa As Variant, Sayfalar As Variant, Sh As Worksheet, Alan As Range, Onay As Variant
    
    Onay = Application.InputBox("İşlem için şifrenizi giriniz.")
    
    If Onay = "12345" Then
        Sayfalar = Array("VERİ ALANI 1", "VERİ ALANI 2", "VERİ ALANI 3")
        
        For Each Sayfa In Sayfalar
            Set Sh = Worksheets(Sayfa)
            With Sh
                .Unprotect "+++"
                 Set Alan = Union(.Range("K1:K5"), .Range("L1,L7,L9"), .Range("M5,M16"))
                 Alan.ClearContents
                .Protect "+++"
            End With
        Next
        MsgBox "Hücreler temizlenmiştir.", vbInformation
    Else
        MsgBox "Hatalı şifre girişi yaptığınız için işleminiz iptal edilmiştir.", vbCritical
    End If
End Sub