Belirli sayfaları toplu olarak şifreleme hk.

[hakanaslan78]

Merhaba Arkadaşlar,

Sizden bir konu da yardım rica edeceğim. Excel çalışma kitabım da 30 adet sekmem bulunuyor ve bu sekmeleri toplu bir şekilde şifreli korumak istiyorum. Şöyle bir durum var, sekmekler den birinde sql den veriler yenile özelliği ile geldiğinden dolayı koruma işlemi yaptığım da, verileri yenileme sekmesi kullanılmaz hale geliyor. Benim sizden ricam, hangi sekmelerin toplu bir şekilde korunacağını kendim belirlemem. Yardımlarınız için şimdiden çok teşekkürler.

Saygılarımla,

Hakan ASLAN

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Belli_Sayfalari_Koru()
    Dim Sayfa As Worksheet
    
    For Each Sayfa In Sheets(Array("Sayfa1", "Sayfa3", "Sayfa5"))
        Sayfa.Protect "12345"
    Next
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[hakanaslan78]

Deneyiniz.

Option Explicit

Sub Belli_Sayfalari_Koru()
    Dim Sayfa As Worksheet
   
    For Each Sayfa In Sheets(Array("Sayfa1", "Sayfa3", "Sayfa5"))
        Sayfa.Protect "12345"
    Next
   
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

Korhan Bey çok teşekkür ederim. Unuttuğum bir nokta oldu, koruduğumuz sayfaları, tekrar dan şifrelerini kaldırmak için, açılan bir pencere ile şifre girerek korumalarını da kaldırmak gerekecek. Bu konuda da yardımınızı rica edeceğim.

Saygılarımla,

Hakan ASLAN

 

[Korhan Ayhan]

Deneyiniz.

Sub Koruma_Kaldir()
    Dim Parola As Variant, Sayfa As Worksheet
    
    Parola = InputBox("Lütfen sayfa koruma şifresini giriniz!", "ŞİFRE GİRİŞİ")
    
    If Parola = "" Or Parola = False Then
        MsgBox "İşleminiz iptal edilmiştir!", vbExclamation
        Exit Sub
    End If
    
    If Parola <> 12345 Then
        MsgBox "Hatalı şifre girişi yaptınız!" & vbCr & "Lütfen daha sonra tekrar deneyiniz.", vbCritical
        Exit Sub
    Else
        For Each Sayfa In Sheets(Array("Sayfa1", "Sayfa3", "Sayfa5"))
            Sayfa.Unprotect Parola
        Next
        
        MsgBox "İşleminiz tamamlanmıştır.", vbInformation
    End If
End Sub

 

[hakanaslan78]

Deneyiniz.

Sub Koruma_Kaldir()
    Dim Parola As Variant, Sayfa As Worksheet
   
    Parola = InputBox("Lütfen sayfa koruma şifresini giriniz!", "ŞİFRE GİRİŞİ")
   
    If Parola = "" Or Parola = False Then
        MsgBox "İşleminiz iptal edilmiştir!", vbExclamation
        Exit Sub
    End If
   
    If Parola <> 12345 Then
        MsgBox "Hatalı şifre girişi yaptınız!" & vbCr & "Lütfen daha sonra tekrar deneyiniz.", vbCritical
        Exit Sub
    Else
        For Each Sayfa In Sheets(Array("Sayfa1", "Sayfa3", "Sayfa5"))
            Sayfa.Unprotect Parola
        Next
       
        MsgBox "İşleminiz tamamlanmıştır.", vbInformation
    End If
End Sub

Çok teşekkür ederim. Emeğinize sağlık.

 

[xternet]

Merhaba Arkadaşlar,
Sayın Korhan Ayhan'ın kodları çok güzel çalışıyor. Eline, zihnine sağlık.
Bu kodları çalışma kitabının farklı şekillerde adlandırılmış tüm sayfalarını şifrelemek ve çözmek için nasıl düzenleyebiliriz?
Tüm ilgilenen arkadaşlara şimdiden çok teşekkür ediyorum.

Bir şey daha eklemek istiyorum.
Buradaki şifre kaldırma kodu otomatik nasıl çözülür?
Yani "koruma kaldır" makrosu çalıştırıldığında şifre sormadan koruma kalkacak şekilde nasıl düzenlenebilir?

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Sayfalari_Koru()
    Dim Sayfa As Worksheet
    
    For Each Sayfa In WorkSheets
        Sayfa.Protect "12345"
    Next
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

Sub Koruma_Kaldir()
    Dim Sayfa As Worksheet   

    For Each Sayfa In WorkSheets
        Sayfa.Unprotect 12345
    Next
       
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[xternet]

Teşekkürler Sayın Korhan Ayhan, elinize zihninize sağlık.