Koşullu sütun şifreleme

[omeryılmaz]

Saygı değer Hocalarım.
Öncelikle Sevgi ve Saygılarımı sunuyorum....

Sağlık Ocağımızda 6 tane Ebe bölgesi mevcut , Anahtar dan 1 No'lu ebe 11 şifresi ile, 2 No'lu ebe 22 şifresi ile ..... ilgili sütunlara ulaşıp aylık olarak verilerini kayıt etmektedir. .

Benim İsteğim : F1 hücresinde hangi ay aktif ise sadece o aya kayıt girebilsinler diğer aylara ait sütunlara giriş şifreli olsun... başka şifre ile Sadece ben girebileyim...

Şimdiden yardımlarınız için şükranlarımı sunuyorum...

 

[omeryılmaz]

Arkadaşlar herhalde konuyu anlatamadım.

Bütün sayfayı koru
Eğer F1 hücresinde Haziran yazılı ise ("M,AA,AO,BC,BQ,CE") sütununun korumasını kaldır
Eğer F1 hücresinde Temmuz yazılı ise ("N,AB,AP,BD,BR,CF") sütununun korumasını kaldır

Application.EnableEvents = False
If Intersect(Target, [F1]) = "Haziran" Then
Range("M,AA,AO,BC,BQ,CE").Application.EnableEvents = True
End If
If Intersect(Target, [F1]) = "Temmuz" Then
Range("N,AB,AP,BD,BR,CF").Application.EnableEvents = True
End If
'.........................
End Sub

.....gibi kod düzenlemek

 

[omeryılmaz]

Arkadaşlar Aşağıdaki kod neden çalışmamaktadır.... hata neresinde..

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, [A1]) = "Temmuz" Then
Application.EnableEvents = False
If Not Intersect(Target, [B:E]) Is Nothing Then
If sor = False Then
i = InputBox("DEĞİŞİKLİK YAPMAYA YETKİLİ İSEN ŞİFREYİ YAZ BAKALIM...!!!")
If i <> 123 Then
Application.Undo
Else
sor = True
End If: End If: End If
Application.EnableEvents = True
End If
End Sub

 

[omeryılmaz]

Arkadaşlar

Dosyayı yeniledim.
Sadece Aktif aya ait sütunlarda kodu pasif yapamıyorum..

Yardımlarınız için şükranlarımı sunuyorum...

 

[omeryılmaz]

koşullu sütun şifreleme

Arkadaşlar bu çalışmayla ilgili değişik fikirleri olan varsa paylaşırsa mutlu olurum..

Benim yapmak istediğim istediğim geçmiş aylara ait girilen bilgileri yetkiliden başkası değişiklik yapamasın.
Hangi ay içersindeysek çalışma arkadaşlarımın sadece o aya ait sütunlara veri girişlerini yapmalarını sağlamak...

 

[omeryılmaz]

Arkadaşlar konuyu mu anlatamadım mı bilemiyorum..

Sağlık Ocaklarında bir çok arkadaşımın kullanacağı bir çalışma yapmaktayım.

Konu hakkında başka düşüncesi olup paylaşmak isteyen yardım severlere ihtiyacım var.

Bende çoktandır uğraşıyorum ama bir türlü çözemedim.Vallahi iki gecedir uyuyamadım. Aklıma birşey geliyor kalkıp uyguluyorum olmuyor. Ne yapacağımı şaşırdım. Çözmem gerekli.. Bu güne kadar hiç bir şey gözeltmeksizin arkadaşlara yardımcı oldum burada da sadece bir çok sağlık ocağında çalışan arkadaşa yardımcı olmak isyiyorum...

Verebileceğiniz fikir ve yapacağınız yardımlar için şimdiden şükranlarımı sunuyorum.

 

[Orion1]

Ömer bey merhaba.
Konuya daha yeni baktım.
Hücrelerin kilidini kaldırıp koymayı denedinizmi.
Aşağıdaki kodlar size bir fikir verebilir sanırım.
Siz de bunu yapacak potansiyeli görüyorum.
Ben aşağıya kodları yazdım tamamlamasıda sizden.
Hadi kolay gelsin size

Activesheet.unprotect
cells.locked=true
Range("A:A,E:E").locked = false
Activesheet.protect

 

[omeryılmaz]

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [b3]) = "Haziran" Then
ActiveSheet.Unprotect
Cells.Locked = True
Range("h:h,ı:ı,j:j,k:k,l:l").Locked = False
ActiveSheet.Protect
End If
'*******************************
If Intersect(Target, [b3]) = "Temmuz" Then
ActiveSheet.Unprotect
Cells.Locked = True
Range("h:h,ı:ı,j:j,k:k,l:l,m:m").Locked = False
ActiveSheet.Protect
End If

End Sub



'vaya *******************************

If Sayfa2.Cells(3, "b") = Haziran Then
If Not Intersect(Target, [H:K]) Is Nothing Then

Hata neresinde.............

 

[omeryılmaz]

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [b3]) = "Haziran" Then
ActiveSheet.Unprotect 123
Cells.Locked = False
Range("H:H,M:M").Locked = True 'KAPALI SÜTUNLAR
ActiveSheet.Protect
End If
'...................
If Intersect(Target, [b3]) = "Temmuz" Then
ActiveSheet.Unprotect 123
Cells.Locked = False
Range("H:H,N:N").Locked = True 'KAPALI SÜTUNLAR
ActiveSheet.Protect
End If
"Şifreyi bilen bu sütunlara girmeli" .......
End Sub
böyle birşey gerekli

 

[Orion1]

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [b3]) Is Nothing Then Exit Sub
    If UCase(Replace(Replace(Target.Value, "ı", "I"), "i", "İ")) = "HAZİRAN" Then
    ActiveSheet.Unprotect
    Cells.Locked = True
    Range("h:h,ı:ı,j:j,k:k,l:l,B3").Locked = False
    ActiveSheet.Protect
End If

'*******************************
If UCase(Target.Value) = "TEMMUZ" Then
    ActiveSheet.Unprotect
    Cells.Locked = True
    Range("h:h,ı:ı,j:j,k:k,l:l,m:m:B3").Locked = False
    ActiveSheet.Protect
End If
end sub

 

[omeryılmaz]

Koşullu Sütun Şifreleme

Kod çalışmadı
Ancak benim istediğim ActiveSheet.Unprotect "123" şifre uygulayıp şifreyi bilen yetkili arkadaşlar geçmiş aylara dönük verilerde değişiklik yapabilsinler.....

Saygılar....

 

[Orion1]

Böyle olmaz tabii.B3 hücresinin Tetiklenmesi için elle bir değer girilmesi gerekiyor.
Ona başka bir çözüm bulacaz.

 

[omeryılmaz]

Herhangi bir hücreye girildiğinde "Worksheet_SelectionChange" olayı ilgili ayı "Ay=(B3)" hücresine makro yazsın.
Bizim için önemli olan veri girecek personelin hangi ayda isek o aya veri girişini sağlamak.


Önemli; Ayrıca yetkili bir kişinin geçmiş aylara dönük değişiklik yapma yetkisi kılınması....

ActiveSheet.Unprotect 123

Şifre = InputBox("Yetkili iseniz değişiklik yapabilmek için Lütfen şifrenizi giriniz.")
If Şifre = "" Then GoTo Son
If Şifre = "123" Then

 

[Orion1]

Bu şekilde olmaz .En doğrusu her kes için bir dosya yapmak.Bu yollddığınız dosyayıda ana dosya yapmak.Kişiler şifresini girip açtıkları dosyadamn ana dosyaya makrolar ile veri girebilmeli.Çok teferutlı bir iş.Bu şekilde bu dosyaya userformlara veya inputboxa makrolar ile kod yazıpta yapayım diyorsuız.Onları bypase etmek çok kolay.Dosyanın makro güvenlik seviyesini yükeseğe çekmekle bürtün yazdığınız kodlar bertaraf olur.
Ben auot open prosedürüne kod yazdım.İşinize yararsa kulanın.sayfa koruma şifresi "123" tür.
Kolay gelsin.