Otomatik hücre kilitleme

[dragman]

Selam arkadaşlar ekte olan bir çalışma dosyam var ben hücrelere değer girdiğimde ve dosyayı kayıt ettiğimde değer girilen hücreler kilitlesin,ekte buna benzer kod var ama eğer değeri yanlış girmişsem açamaya gidiyorum hücreden ayrılınca hemen kilitleniyor ben hemen kilitlenmesini istemiyorum ne zaman save yaptım o zaman açtığım hücre kilitlensin.Biraz uzun oldu ama kusura bakmayınız şimdiden teşekkür ederim.
Şifre:123

 

[Muzaffer Ali]

Merhaba.

Sayfalardaki bütün kilitleme kodlarını silin
Aşağıdaki kodu "BuÇalışmaKitabı" adlı kod sayfasına kopyalayın.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    ActiveSheet.Unprotect 123
    Cells.SpecialCells(xlCellTypeBlanks).Locked = False
    Cells.SpecialCells(xlCellTypeConstants).Locked = True
    Cells.SpecialCells(xlCellTypeAllValidation).Locked = True
    ActiveSheet.Protect 123
End Sub

Her Kaydet işleminden önce çalışır.

 

[dragman]

Hayır hocam çalışmıyor,şöyleki ben bütün sayfayı kilitlersem çalışıyor ben boş hücreye değer girmek istediğimde boş hücrelerin kilidini açıp değer giriyorum bu sefer.Benim istediğim değer girdimde hafızaya aldığım da değer girdiğim hücre yanlız kilitlensin bütün sayfa değil.
2.cisi değer girdiğim hücreyi açtığımda hemen kilitlenmesin kayıt yaptığımda hücreyi kilitlesin.Saygılar...

 

[ÖmerFaruk]

Tüm sayfalardan mevcut kodları silin
This Workbook kısmına aşağıdakileri olduğu gibi yapıştırın.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim Sayfa As Worksheet
    For Each Sayfa In Worksheets
        If IsNumeric(Sayfa.Name) Then
            Sayfa.Unprotect "123"
            Sayfa.Cells.Locked = True
            Sayfa.Protect "123"
        End If
    Next Sayfa
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Target.Activate
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    If Not IsNumeric(ActiveSheet.Name) Then Exit Sub
    xx = Target.Address
    If Target.Locked = False Then Exit Sub
    ActiveSheet.Unprotect "123"
    Target.Locked = False
    ActiveSheet.Protect "123"
End Sub

 

[dragman]

Tüm sayfalardan mevcut kodları silin
This Workbook kısmına aşağıdakileri olduğu gibi yapıştırın.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim Sayfa As Worksheet
    For Each Sayfa In Worksheets
        If IsNumeric(Sayfa.Name) Then
            Sayfa.Unprotect "123"
            Sayfa.Cells.Locked = True
            Sayfa.Protect "123"
        End If
    Next Sayfa
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Target.Activate
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    If Not IsNumeric(ActiveSheet.Name) Then Exit Sub
    xx = Target.Address
    If Target.Locked = False Then Exit Sub
    ActiveSheet.Unprotect "123"
    Target.Locked = False
    ActiveSheet.Protect "123"
End Sub

Yok hocam çalışmıyor.İlginiz için teşekkür ederim..

 

[ÖmerFaruk]

Genelde deneyerek gönderirim cevapları. Bu cevabı da denedim, çalıştığını gördüm ve öyle paylaştım..
Çalışmayan ya da olmayanın ne olduğunu söyleyebiliyor musun?
Kodları doğru yere yapıştırdığınıza emin misiniz?

 

[dragman]

Evet hocam isterseniz bir kaç sayfayı siz yapınız ekleyiniz indireyim onu.Kodları doğru yere yapıştırdım hücreleri dolduruyorum ama hiç haraket yok hücreyi kilitlemiyor.

 

[ÖmerFaruk]

Hayır hocam çalışmıyor,şöyleki ben bütün sayfayı kilitlersem çalışıyor ben boş hücreye değer girmek istediğimde boş hücrelerin kilidini açıp değer giriyorum bu sefer.Benim istediğim değer girdimde hafızaya aldığım da değer girdiğim hücre yanlız kilitlensin bütün sayfa değil.
2.cisi değer girdiğim hücreyi açtığımda hemen kilitlenmesin kayıt yaptığımda hücreyi kilitlesin.Saygılar...

Siz zaten mesajınızda böyle istediniz.
Kodları doğru yere yapıştırdıysanız dosyanızı kaydettiğiniz an tüm hücreler kilitlenecek otomatik olarak.
Herhangi bir sayfada bir hücreyi seçince o hücrenin kilidi açılıyor ve dosyayı kaydedene kadar durumunu muhafaza ediyor.
Dosyayı kaydedince, tüm sayfaları kontrol edip tüm hücreleri tekrar kilitliyorum.

 

[dragman]

Yok hocam öyle olmaycak değer girdiğim hücre kilitenecek kaydetten sonra,değer girilmeyen ise kilitsiz olacak ben ne zaman değer girdim oda kadetten sonra kilitlensin istiyorum.Saygılar

 

[ÖmerFaruk]

Ben soruyu halen anlayamadım. Muzaffer hocam takiptedir. Sanırım o daha doğru cevap verecektir.

 

[dragman]

Hocam soru şu ben hangi hucreye değer girdiğimde kaydetten sonra o hücre kilitlensin istiyorum.

 

[dragman]

Selam arkadaşlar ekte olan bir çalışma dosyam var ben hücrelere değer girdiğimde ve dosyayı kayıt ettiğimde değer girilen hücreler kilitlesin,ekte buna benzer kod var ama eğer değeri yanlış girmişsem açamaya gidiyorum hücreden ayrılınca hemen kilitleniyor ben hemen kilitlenmesini istemiyorum ne zaman save yaptım o zaman açtığım hücre kilitlensin.Biraz uzun oldu ama kusura bakmayınız şimdiden teşekkür ederim.
Şifre:123

Burada sorduğumda o zaman ordaki kodlar için geçerli idi şimdi onları temizledim,Yeni vba kodlarını siz değerli arkadaşlardan bekliyorum.

 

[Muzaffer Ali]

Sayın @dragman yazdıklarınızın tamamını okudum doğru anlamış mıyım?

1- Boş bir hücreye değer girersem kodlar hiçbir işlem yapmasın.
2- Dolu bir hücrede değişiklik yapmak istersem sayfa kilidini kendim manuel kaldırıp değişiklik yapacağım.
3- Veri girme ve silme gibi işlemlerim bittikten sonra dosyayı kaydedersem kodlar çalışsın.
-Başka bir ifade ile kodlar sadece dosyayı kaydettiğimde çalışsın başka hiçbir zaman çalışmasın.
4- Kodlar boş hücrelerin kilidini kaldırsın, dolu hücreleri kilitlesin.
5- Sayfayı "123" şifresi ile korumaya alsın.

Eğer doğruysa 2. mesajda yazdığım kodlar işinizi görüyor.
Ancak mutlaka sayfalarda bulunan eski kodları silmeniz gerekiyor.

 

[dragman]

Sayın @dragman yazdıklarınızın tamamını okudum doğru anlamış mıyım?

1- Boş bir hücreye değer girersem kodlar hiçbir işlem yapmasın.
2- Dolu bir hücrede değişiklik yapmak istersem sayfa kilidini kendim manuel kaldırıp değişiklik yapacağım.
3- Veri girme ve silme gibi işlemlerim bittikten sonra dosyayı kaydedersem kodlar çalışsın.
-Başka bir ifade ile kodlar sadece dosyayı kaydettiğimde çalışsın başka hiçbir zaman çalışmasın.
4- Kodlar boş hücrelerin kilidini kaldırsın, dolu hücreleri kilitlesin.
5- Sayfayı "123" şifresi ile korumaya alsın.

Eğer doğruysa 2. mesajda yazdığım kodlar işinizi görüyor.
Ancak mutlaka sayfalarda bulunan eski kodları silmeniz gerekiyor.

1-Selamlar hocam sıraladıkların ben eklediğim dosyadaki kodlar için geçerliydi,biz o kodları sileceğimize göre ilk mesajdaki isteklerim geçersizdır.
2-istediğim şu ben "B" ile "H" sütünları arasındaki hücreye değer girdiğimde o hücre kilitlensin ve şifre konsun bunu istiyorum saygılar...

 

[Muzaffer Ali]

Merhaba.
Öncelikle Bütün sayfalardaki kodları silin.

Aşağıdaki kodu "BuÇalışmaKitabı" adlı kod sayfasına kopyalayın.
Dosyadaki herhangi bir sayfada "B:H" aralığında bir değişiklik olduğunda aşağıdaki kodlar çalışır.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If Not Intersect(Target, Range("B:B")) Is Nothing Then
        ActiveSheet.Unprotect 123
        If Target = "" Then
            Target.Resize(1, 3).Locked = False
        Else
            Target.Resize(1, 3).Locked = True
        End If
        ActiveSheet.Protect 123
    ElseIf Not Intersect(Target, Range("E:H")) Is Nothing Then
        ActiveSheet.Unprotect 123
        If Target = "" Then
            Target.Locked = False
        Else
            Target.Locked = True
        End If
        ActiveSheet.Protect 123
    End If
End Sub

 

[dragman]

Yok hocam hiçbiri çalışmıyor.Tek çalışan aşağıdaki kodlardır bu kodlarda tek istediğim sayfanın şifresini açtığımda sütünü tıklar tıklamaz hemen sayfayı kilitliyor,ben 5 dk sonra sayfayı kilitlesin istiyorum.Arkadaşlar bana sadece süreyi ekleyiniz yeter.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
ActiveSheet.Unprotect 123
If ActiveCell <> "" Then Selection.Locked = True
If ActiveCell = "" Then Selection.Locked = False
ActiveSheet.Protect 123
End Sub

 

[ÖmerFaruk]

Her yeni mesajınızda sorunuz evrim geçiriyor.

 

[dragman]

Her yeni mesajınızda sorunuz evrim geçiriyor.
[/QUOT

Selamlar hocam bakıyorum olmuyoro yüzden evrim geçirdi.Gene en baştaki çalışan fakat süresi kısa olmasından dolayı beğenmiyordum ona mecbur kaldım ona sadece 5 dk sonra çalış desek yeterlidır benim için.

 

[Muzaffer Ali]

Yeterli olacağını hiç sanmıyorum.
Kolay gelsin size.