Çözüldü Sayfa Koruması hk.

[yunusemre16]

Merhaba, Sayfa Koruması yaparken formüllü olan hücreleri kapatıyorum değiştirilmesin diye, benim sorum şu şekilde olacak,

Sayfa sayılarım 30 a kadar yani 30 sayfada da aynı hücreleri korumam gerekiyor, ama yeri geldiğinde koruduğum hücreleri açmam gerekiyor, ama malesef her sayfada tek tek korumayı kaldır veya korumayı etkinleştir yapmam gerekiyor, bunu bütün excelde kilitli hücreleri koru şeklinde yapabilirmiyim

 

[Mahmut Bayram]

Sub tum_sayfalari_koru()
top:
pass = InputBox("Şifre?")
repass = InputBox("Şİfreyi Doğrula")

If Not (pass = repass) Then
    MsgBox "Yanlış doğrulama"
GoTo top
End If

For i = 1 To Worksheets.Count
    If Worksheets(i).ProtectContents = True Then GoTo oops
Next
    For Each s In ActiveWorkbook.Worksheets
        s.Protect Password:=pass
        Next
Exit Sub
oops: MsgBox "Önceden korunmuş bazı sayfaların olduğunu düşünüyorum. Lütfen tüm sayfaların korumasını kaldırın, sonra bu Makroyu çalıştırın."
End Sub

Sub sayfa_korumalarini_kaldir()
Dim wSheet As Worksheet
Dim Pwd As String
    Pwd = InputBox("Tüm çalışma sayfalarının korumasını kaldırmak için şifrenizi girin", "Şifre girişi")
        On Error Resume Next
    For Each wSheet In Worksheets
       wSheet.Unprotect Password:=Pwd
    Next wSheet
If Err <> 0 Then
    MsgBox "Yanlış bir şifre girdiniz. Tüm çalışma sayfaları korunamadı.", vbCritical, "Yanlış Şifre"
End If
        On Error GoTo 0
End Sub

 

[yunusemre16]

Sub tum_sayfalari_koru()
top:
pass = InputBox("Şifre?")
repass = InputBox("Şİfreyi Doğrula")

If Not (pass = repass) Then
    MsgBox "Yanlış doğrulama"
GoTo top
End If

For i = 1 To Worksheets.Count
    If Worksheets(i).ProtectContents = True Then GoTo oops
Next
    For Each s In ActiveWorkbook.Worksheets
        s.Protect Password:=pass
        Next
Exit Sub
oops: MsgBox "Önceden korunmuş bazı sayfaların olduğunu düşünüyorum. Lütfen tüm sayfaların korumasını kaldırın, sonra bu Makroyu çalıştırın."
End Sub

Sub saya_korumalarini_kaldir()
Dim wSheet As Worksheet
Dim Pwd As String
    Pwd = InputBox("Tüm çalışma sayfalarının korumasını kaldırmak için şifrenizi girin", "Şifre girişi")
        On Error Resume Next
    For Each wSheet In Worksheets
       wSheet.Unprotect Password:=Pwd
    Next wSheet
If Err <> 0 Then
    MsgBox "Yanlış bir şifre girdiniz. Tüm çalışma sayfaları korunamadı.", vbCritical, "Yanlış Şifre"
End If
        On Error GoTo 0
End Sub

Çok teşekkür ederim