Birden çok sayfayı aynı şifre ile topluca korumaya alma veya kaldırma

[ertuer]

Değerli arkadaşlar.
Örneğin bir çalışma sayfamda 31 adet sayfa mevcut ve bunların formülleri vb bozulmasın diye hepsini tek tek korumaya alıyorum veya gerektiğinde hepsini tek tek kaldırmak zorunda kalıyorum.Zannediyorum tüm sayfaları aynı şifre ile korumaya alıp aynı şekilde de kaldıracak bir yol vardır..Ben bulamadım yardımcı olmanızı rica ederim

 

[Metin Karaağaç]

Sub sifrele()
For a = 1 To Sheets.Count
Sheets(a).Protect "....." = True
Next
End Sub

Sub sifreac()
For a = 1 To Sheets.Count
Sheets(a).Unprotect "...." = True
Next
End Sub

Noktalı yerlere belirlediğiniz bir şifre yazın.

 

[ertuer]

sayfaları toplu koruma

Sn. Karaağaç
Öncelikle ilginize teşekkür ederim.
Ancak ya ben bir hata yaptım yada bir başka problem var makroyu çalıştıramadım.
Bu sebeple ekteki dosyayı gönderiyorum.eğer buna uygularsanız çok memnun olurum.

emeğinize saygı ile selamlar

 

[Metin Karaağaç]

Noktalı yerlere bir şifre yazın demiştim, siz aynen kullanmışsınız.
Şifreyi "1234" olarak ayarladım.

 

[ertuer]

birden çok sayfanın formüllerini topluca koruma ve kaldırma

Sn Karaağaç
Ben de söylediğiniz gibi noktalı yere şifre yazdım ama fazla olan noktalı yerleri silmedim.
Hata mı anladım bu sayede bunu da öğrenmiş oldum.
Ancak kullanım açısından ve benim amacıma uygun olması için şöyle olursa daha iyi olacak:

1 koruma aç kaldır gibi butonlar olmayacak
2 tüm sayfa değil sadece şifreli hücreler korunsun
3 şifreli hücrede değişiklik yapılmak istendiğinde (daha doğrusu benim değişiklik yapmak istediğimde) şifre sorsun.

ilgili dosyaya böyle bir makro yazma imkanı varsa tam istediğim olacak.
Olursa da ılmazsa da emeğinize saygı ile selamlar.

 

[Metin Karaağaç]

1 Butonları silebilirsiniz, tabii korumayı kaldırdıktan sonra.
2 Herhangi bir sayfada bütün hücreleri seçip (1. satırın üstü ve A sütununun solu) farenin sağ tuşuna basın ve hücreleri biçimlendir deyin. Çıkan pencereden "koruma" sekmesine tıklatın ve "kilitli" onay kutusunu kaldırın. Sonra korumalı olmasını istediğiniz hücreleri seçerek tekrar hücreleri biçimlendir deyin ve bu sefer koruma sekmesinden "kilitli" yapın. Böylece korumayı aktif ettiğinizde sadece o hücreler değiştirilemez ve silinemez olacaktır.
3 Bu isteğinizi yerine getiremiycem, size verdiğim kodlarda şifreyi soran bi düzenleme yapmam gerekiyor. Makro konusunda zayıf olduğum için çözümü bilmiyorum ama sanırım forumdaki diğer arkadaşlar yardımcı olabilir.

Kolay gelsin..

 

[Metin Karaağaç]

Sanırım bu kodlar çalışıyor. Bir de siz deneyin.

Sub sifrele()
For a = 1 To Sheets.Count
Sheets(a).Protect "1234" = True
Next
End Sub

Sub sifreac()
If InputBox("Şifreyi girin") = "1234" Then
For a = 1 To Sheets.Count
Sheets(a).Unprotect "1234" = True
Next
End If
End Sub

 

[ertuer]

Çalışma kitabının tüm sayfalarındaki formülleri koruma ve açma

Değerli arkadaşlar,
Kullandığımız bir excel çalışma tablosun da örneği 31 adet sayfa var.
Busayfalardaki formüllerin kullanıcılar tarafından veya yanlışlıkla bozulmaması için koruma gerekmektedir.ancak Bir değişiklik yapacağımız zaman tek tek 31 sayfanın korumasını kaldır tekrar kapat vs....Buna bir çözüm olarak Çalışma kitabının tüm sayfalarını aynı şifre ile tümden
korumaya alıp korumayı kaldıracak bir formül mü makromu gerekli bu konuda bilgim yetmemektedir. Yardımcı olabilecek arkadaşlara şimdiden teşekkür ederim

 

[fedeal]

sayın Metin Karaağacın son verdigi kodlar güzel aslında calışmanıza sağ tıklama korumaya alır, iki tıklamayla şifreli girişle açılır şeklinde uyarladım. şimdi ben sadece formül olan hücreleri korumak istiyorum derseniz:
sayfanın tamamını seçip hücreleri biçimlerdir-koruma-kitli yi iptal edin
sonra formül olan hücreleri seçip hücreleri biçimlerdir-koruma-kitli yapın bu şekilde tüm sayfaları tektek yaparsanız işinizi görür kanımca.(sağ tıklamada makro kodu oldugu için biçimlendirmeyi biçim-hücrelerden koruma yokken yapın.) saygılar.
şifre:1234

 

[aytacesmebasi]

Merhaba, bu kodları kullanarak şifreleme yapabiliyorum. Aklıma bir fikir geldi ama uygulayamadım. Fikir şu;

Şifre bir hücrede yazılı olsun, mesela sayfa1deki a1 hücresindeki değer şifre olsun.

Sağ tıklama ve çift tıklama komutuda güzel bu bütün sayfada değilde sadece bir hücrede olsa yani sayfa2deki a2 hücresine iki tıklama yapıldığında şifreleme olsa sağ tıklama olduğunda şifre açılsa

 

[Seyit Tiken]

Aşağıdaki gibi deneyiniz.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
Sayfa1.Protect [a1]
MsgBox "Sayfa Şifrelendi"
End Sub
'-----------------------------
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
Sayfa1.Unprotect [a1]
MsgBox "Şifre Açıldı"
End Sub

 

[asuzen]

Aşağıdaki gibi deneyiniz.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
Sayfa1.Protect [a1]
MsgBox "Sayfa Şifrelendi"
End Sub
'-----------------------------
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
Sayfa1.Unprotect [a1]
MsgBox "Şifre Açıldı"
End Sub

Hocam gayet güzel çalışıyor fakat bu sefer her çift tıklamada ya da sağ tıklamada çalışıyor. Bunu ctrl gibi bir tuş kombinasyonu ile uygulasak ya da bir kere korumaya girdikten sonra çit tıklamada (zaten sayfa korumada olduğu için) normal işlevini yapsa nasıl olur? (Aynı şey sağ tıklamada da geçerli) İlgili sayfada hiçbir şekilde çift tıklama ya da sağ tıklama çalışmıyor bu şekilde.
İnşallah anlatabilmişimdir istediğimi....

 

[Korhan Ayhan]

Merhaba,

Alternatif olarak aşağıdaki kodu deneyebilirsiniz.

Kodu Sayfa2 isimli sayfanın kod bölümüne uygulayınız.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Address = "$A$2" Then
        Cancel = True
        ActiveSheet.Protect [Sayfa1!A1]
    End If
End Sub
 
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Address = "$A$2" Then
        ActiveSheet.Unprotect [Sayfa1!A1]
    End If
End Sub

 

[asuzen]

Merhaba,

Alternatif olarak aşağıdaki kodu deneyebilirsiniz.

Kodu Sayfa2 isimli sayfanın kod bölümüne uygulayınız.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Address = "$A$2" Then
        Cancel = True
        ActiveSheet.Protect [Sayfa1!A1]
    End If
End Sub
 
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Address = "$A$2" Then
        ActiveSheet.Unprotect [Sayfa1!A1]
    End If
End Sub

Hocam çok teşekkürler bu şekilde sadece a2 hücresine tıkladığımızda işlem yapıyor diğerlerinde yapmıyor. Böylece karışıklık yaşanmıyor.
Emeğinize sağlık.

 

[hatirlabeni]

kodları her sayfa için ayrımı uygulayacagız ?

 

[fenci2737]

Sanırım bu kodlar çalışıyor. Bir de siz deneyin.

Sub sifrele()
For a = 1 To Sheets.Count
Sheets(a).Protect "1234" = True
Next
End Sub

Sub sifreac()
If InputBox("Şifreyi girin") = "1234" Then
For a = 1 To Sheets.Count
Sheets(a).Unprotect "1234" = True
Next
End If
End Sub

merhaba sizin bu kodu kullandım çalıştı ancak benim şöyle bir sorunum var. 4 tane makro ile çalışan buton var onlar çalışmadı korumada şifre olduğu için. ben bu makroları sizin koddan önce manuel koruma kaldırıp tekrar koruma yaparak oluşturdum. benim makroları nasıl düzeltirim.
mesela bir tane makro aşağıdaki gibi


Sub etiket3()
'
' etiket3 Makro
'

'
ActiveSheet.Unprotect
ActiveWindow.SmallScroll Down:=-9
Range("W5:AA8").Select
Selection.Copy
Range("W9:AA12").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Replace What:="ı", Replacement:="i", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
Cells.Find(What:="ı", After:=ActiveCell, LookIn:=xlFormulas2, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
Application.CutCopyMode = False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFiltering:=True
Range("AB11").Select
Selection.Copy
End Sub