VBA ile sayfa koruma şifresini belirli sayfa ve hücreye atama yardımı

[Believing]

Sayın uzman arkadaşlar,

Aşağıdaki kod ile sayfaları koruyor veya koruma kilidini kaldırıyorum.

Sub Sayfa_Koru()
For Each syf In Worksheets
    syf.Protect 12345, DrawingObjects:=True, Contents:=True, Scenarios:=True
    syf.EnableSelection = xlNoSelection
Next
MsgBox "Tüm sayfalar korumaya alındı.", vbInformation, "İŞLEM SONUCU"
End Sub
Sub Koruma_Ac()
Sifre = Application.InputBox("Lütfen koruma şifresini giriniz.", "ŞİFRE SORGU EKRANI")
If Sifre = False Then Exit Sub
If Sifre = "12345" Then
For Each syf In Worksheets
    syf.Unprotect Sifre
Next
Else:
MsgBox "Yanlış şifre girdiniz.", vbCritical, "UYARI"
End If
End Sub

Sayfa koruma şifresini SETTING isimli sayfanın A1 hücresinden alması için yukarıdaki kodları nasıl revize etmeliyim.
Uzman arkadaşların çok değerli yardımlarını rica ediyorum.

Saygılarımla,
Ömer Ali ÜZÜMCÜ

 

[ÖmerBey]

Merhaba,
Kullandığınız her iki kodun başına sfr = Sheets("SETTING").Range("A1") satırını ilave ettikten sonra kodunuzdaki 12345 yazan yerleri sfr olarak değiştiriniz.

 

[işsiz123]

Merhaba,
Aşağıdaki gibi deneyebilirsiniz.

Sub Sayfa_Koru()
aa = Sheets("SETTING").Range("A1")
For Each syf In Worksheets
    syf.Protect aa, DrawingObjects:=True, Contents:=True, Scenarios:=True
    syf.EnableSelection = xlNoSelection
Next
MsgBox "Tüm sayfalar korumaya alındı.", vbInformation, "İŞLEM SONUCU"
End Sub
Sub Koruma_Ac()
On Error Resume Next
Sifre = Application.InputBox("Lütfen koruma şifresini giriniz.", "ŞİFRE SORGU EKRANI")
If Sifre = False Then Exit Sub


For Each syf In Worksheets
    syf.Unprotect Sifre
Next

If Err.Number <> 0 Then
MsgBox "Yanlış şifre girdiniz.", vbCritical, "UYARI"
End If

End Sub

 

[Believing]

Merhaba,
Aşağıdaki gibi deneyebilirsiniz.

Merhaba,
Kullandığınız her iki kodun başına sfr = Sheets("SETTING").Range("A1") satırını ilave ettikten sonra kodunuzdaki 12345 yazan yerleri sfr olarak değiştiriniz.

Sayın Ömer bey,

Yardımınız için size çok teşekkür ederim.

Saygılarımla,
Ömer Ali ÜZÜMCÜ

 

[Believing]

Merhaba,
Aşağıdaki gibi deneyebilirsiniz.

Sub Sayfa_Koru()
aa = Sheets("SETTING").Range("A1")
For Each syf In Worksheets
    syf.Protect aa, DrawingObjects:=True, Contents:=True, Scenarios:=True
    syf.EnableSelection = xlNoSelection
Next
MsgBox "Tüm sayfalar korumaya alındı.", vbInformation, "İŞLEM SONUCU"
End Sub
Sub Koruma_Ac()
On Error Resume Next
Sifre = Application.InputBox("Lütfen koruma şifresini giriniz.", "ŞİFRE SORGU EKRANI")
If Sifre = False Then Exit Sub


For Each syf In Worksheets
    syf.Unprotect Sifre
Next

If Err.Number <> 0 Then
MsgBox "Yanlış şifre girdiniz.", vbCritical, "UYARI"
End If

End Sub

Sayın İşsiz123,

Konuya gösterdiğiniz ilgi ve yardım için size çok teşekkür ederim.
ALLAH sizden ve sevdiklerinizden razı olsun.
Hakkınızı helal ediniz lütfen.

Saygılarımla,
Ömer Ali ÜZÜMCÜ

 

[işsiz123]

Sayın İşsiz123,

Konuya gösterdiğiniz ilgi ve yardım için size çok teşekkür ederim.
ALLAH sizden ve sevdiklerinizden razı olsun.
Hakkınızı helal ediniz lütfen.

Saygılarımla,
Ömer Ali ÜZÜMCÜ

Rica ederim iyi çalışmalar.
Amin cümlemizin inşallah