Sayfa koru herseyi mafetti

[kaleci]

Merhaba arkadaslar,

Bir problemim var ve henüz cözümünü bulamadim. Bu soruya yardimci olacak bir arkadas var mi?

Sahifeyi koru funksiyonu herseyi mafetti.
„Araclar-Koru- Kullanici bölge koruyucusu“ ile ayarladim ve cokgüzel calisti ama Hücrelere arka cephede renk vermistim o kayboldu, Satir ekle, sütun ekle, Extra bilgi ekle funksiyonlari kayboldu. Neden?

Satir ekle, sütun ekle, Extra bilgi ekle fonksiyonlarini (gri renk oldu) görünüyor ama görev yapmiyor. Bunlari nasil tekrar calisir duruma getiririz?

ActiveSheet.Unproctect ve ActiveSheet.Protect yazmama ragmen yine olmuyor.


Kullanici bölge koruyucusunu asagidaki gibi ayarladim: Cünkü benim sayfa üzerinde 6 degisik Sifre ile calismam lazim. Ama yukaridaki özelligi engellenen fonksiyonlarda cok önemli.

Bölge1 =$E$3:$H$399 Sifre:a
Bölge2 =$I$3:$L$399 Sifre: b
Bölge3 =$M$3:$P$399 Sifre: c
Bölge4 =$Q$3:$T$399 Sifre: d
Bölge5 =$U$3:$W$399 Sifre: e
Bölge6 =$X$3:$AC$399 Sifre: f

Private Sub Worksheet_Change(ByVal Target As Range)
Dim RaBereich As Range, RaZelle As Range
Set RaBereich = Range("E4:AM399")
' ActiveSheet.Unprotect
For Each RaZelle In Range(Target.Address)
If Not Intersect(RaZelle, RaBereich) Is Nothing Then
If Intersect(RaZelle, RaBereich) Is Nothing Then
With Range(RaZelle.Address, RaZelle.Offset(0, 0).Address)
Select Case UCase(RaZelle.Value) ' UMWANDLUNG DER Eingabe in Großbuchstaben

Case "U" (Case "U", Case "k",L,AU,GZ 5 defa kisaltmalari özellikle ile birlikte yazdim)
' rot
.Interior.ColorIndex = 4
'.Font.ColorIndex = 0
' Schriftfarbe automatisch
'.NumberFormat = "General"
' Zellenformat Standard

Case "K"
……………………………………………………………
………………………………………………………….
(Case L,AU,GZ 5 defa kisaltmalari özellikle ile birlikte yazdim)

Case Else
' Keine
.Interior.ColorIndex = xlNone
'.Font.ColorIndex = 0
' Schriftfarbe automatisch
'.NumberFormat = "General"
' Zellenformat Standard
End Select
End With
End If
End If
Next RaZelle
' ActiveSheet.protect
End Sub

 

[Levent Menteşoğlu]

Sayfaya koruma koyduğunuzda bunun kıstaslarını çıkan pencerede ayarlayabiliyorsunuz.

 

[kaleci]

Sayin Leventm

Siz bana su anakadar ögrenmemde cok yardimci oldunuz. Bundan dolayi once tesekkür etmeyi kendime bir borc biliyorum.
Sayin Hocam,

Size ikitane yari dosya gönderiyorum, cünkü ayri ayri yollardan birseyler yapmaya calistim.
Asagidaki gönderecegim “Test1” isimli dosyanin tamamini formdaki arkadaslarin yardimi ile yaptim. Dosya cok ta isime yaramisti.

Dosyaya herkes kayit yapip silince ortaya bir karisiklik ve problem cikti. Biz de 6 arkadas sorumluluk aldik ve herkes sayfadaki bilgileri okuyabilecek ama bu 6 tane arkadaslardan her biri saadece kendisine ait olan sütunlari kendi sifresi ile girip selebilecek ve degistirebilecek.

Sayin Hocam,
Dosyanin 6. sütununda bir sifreleyici var. Lütfen 6. sütunda herhangibir hücreye tiklayiniz.
Sifre: "test"
Ben bunu asagidaki gibi gelistirmeyi istedim ama beceremedim.

1. Kullanicinin bölgesi (“E3:H399”) Sifre: jung
2. Kullanicinin bölgesi (“I3:L399”) Sifre: klemens
3. Kullanicinin bölgesi (“M3399”) Sifre: hartmann
4. Kullanicinin bölgesi (“Q3:T399”) Sifre: frenz
5. Kullanicinin bölgesi (“U3:W399”) Sifre: fiedler
6. Kullanicinin bölgesi (“X3:AC399”) Sifre: mann

Asagidaki Kod’u “If RaZelle.Column = 6 Then” söyle If RaZelle.Columns = (“E3:H399”) Then degistirebilsem herhalde olacak. Ben VBA da yeni oldugum icin hep deneye deneye sonuca ulasiyorum. Kendim kod yazamadigim icin olup olmayacaginida bilmiyorum. Belki olur.

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim RaZelle As Range
Dim InMldg As Integer
For Each RaZelle In Range(Target.Address)
If RaZelle.Column = 6 Then
BoPasswort = False
UserForm1.Show
If BoPasswort = True Then Exit Sub
Application.EnableEvents = False
If Target.Count = 1 Then
Target.Offset(0, 1).Select
Else
Range("A1").Select
End If
Application.EnableEvents = True
Exit For
End If
Next RaZelle
End Sub

Simdiden ilgilenen arkadaslara tesekkür ederim

Sayin Hocam size yönelttigim ilk sorunun dosyasi "Test2" Sifraler ise söyle
Sayfa koru sifresi:buro.

1. Kullanicinin bölgesi (“E3:H399”) Sifre: jung
2. Kullanicinin bölgesi (“I3:L399”) Sifre: klemens
3. Kullanicinin bölgesi (“M3399”) Sifre: hartmann
4. Kullanicinin bölgesi (“Q3:T399”) Sifre: frenz
5. Kullanicinin bölgesi (“U3:W399”) Sifre: fiedler
6. Kullanicinin bölgesi (“X3:AC399”) Sifre: mann

kaleci

 

[kaleci]

Ikinci Dosya "Test2"

 

[Levent Menteşoğlu]

Verdiğiniz kodu iptal ederek yerine aşağıdaki kodu deneyin.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(ActiveCell, [e3:h339]) Is Nothing Then say = 0
If Not Intersect(ActiveCell, [i3:l339]) Is Nothing Then say = 1
If Not Intersect(ActiveCell, [m3:p339]) Is Nothing Then say = 2
If Not Intersect(ActiveCell, [q3:t339]) Is Nothing Then say = 3
If Not Intersect(ActiveCell, [u3:w339]) Is Nothing Then say = 4
If Not Intersect(ActiveCell, [x3:ac339]) Is Nothing Then say = 5
If say = "" Then Exit Sub
sifre = Array("jung", "klemens", "hartmann", "frenz", "fiedler", "mann")
sor = InputBox("Şifreyi giriniz?", "ŞİFRE")
If sor = "" Then
[a1].Select
Exit Sub
Else: If sor = sifre(say) Then Exit Sub
MsgBox "Şifre yanlış"
[a1].Select
End If
End Sub

 

[kaleci]

Sayin Hocam,

Ellerine saglik, simdi rahat rahat derinden bir nefes aldim.

Hocam tam istedigim gibi olmus, sayfaya kayit yapmak istedigimizde sifresiz kayit yaptirmiyor, cok güzel.

Hocam,
Dikkatinizi cekti mi? Izin kayitlarini Button üzerinden yapmak istersek, sifresiz olarak kaydediliyor. Burayida engelletirebilirmiyiz.
Sayfada
"Daten-Eingabe" denilen buttona tiklayip,
ComboBox'tan bir isim secip,
Takvimden izin baslangic tarihine ve izin bitis tarihlerine tiklayip,
CheckBoxtaki "Urlaub= U" buttonuna tikladigimizda, sayfaya hala kayit yapiyor.

Saygilarimla
kaleci