Koşullu Satır Kilitleme

sleeper · 27 Mart 2014

A sütununa girilen isme göre o satırı komple kilitlemek istiyorum. Yalnız benim için en önemli ve olmazsa olmazım kilitlenen satırda değişiklik yapmaya çalıştığımda bana şifre sorsun ve doğru şifreyi girdiğimde o satırın kilidi açılsın istiyorum.

hamitcan · 27 Mart 2014

İlgili sayfanın kod kısmına ekleyin. A1 hücresine "ALİ" yazdığınızda kod çalışır.

Kod:

Private Sub Worksheet_Change(ByVal Target As Range)
    sfr = 123
    If Target.Address <> "$A$1" Then Exit Sub
    If Target.Text = "ALİ" Then
        Cells.Locked = False
        Rows(2).Locked = True
        ActiveSheet.Protect sfr
    End If
End Sub

sleeper · 27 Mart 2014

Cevabın için teşekkür ederim @hamitcan. Kodlarını inceledikten sonra tam olarak istediğim şeyi eksik ve yanlış ifade ettiğimin farkına vardım.

Sayfadaki bütün hücreler kilitli haldeyken Ali isimli kullanıcı dosyayı açtığında şifre soracak ve Ali'nin belirlediği şifreyi girenler A sütununda sadece "Ali" yazılı satırlarda değişiklik yapma yetkisini kazanacak. Aynı şekilde Ayşe isimli kullanıcı bu dosyayı açtığında şifre soracak ve Ayşe kendi şifresini girdiğinde sadece kendisine ait satırlarda değişiklik yapma hakkını kazanacak. Bunun gibi 8 tane şifre tanımlanmış olacak ve herkes kendi satırında yetki sahibi olmuş olacak.

Amacım paylaşımda olan bir dosyada birden fazla kişi çalışıyor ve her birinin belirli satırlarda değişiklik yapma hakkı bulunuyor. Kimse kimsenin satırında değişiklik yapmamasını istiyorum.

Şimdiye kadar "Kullanıcıların Aralıkları Düzenlemesine İzin Ver" kısmından herkese önceden belirlenen sütunlarda şifre tanımlamıştım, fakat artık önceden belirlenemeyecek şekilde yetki vermem gerekmektedir. Ondan dolayı böyle bir kodlamaya ihtiyaç duymaktayım.

Yardımlarınızı esirgemezseniz çok sevinirim.

hamitcan · 27 Mart 2014

3 adet kullanıcı tanımladım. ALİ,VELİ,MEHMET. Şifreler, 1,2,3.
Ali 1.satırı, VELİ, 2. satırı, Mehmet 3. satırı kullanabiliyor.
Form için gerekli nesneler: 2 adet Label, 2 adet TextBox, 1 adet CommandButton.
UserForn içine aşağıdaki kodu ekleyin.

Kod:

Private Sub CommandButton1_Click()
    If TextBox1 = "ALİ" And TextBox2 = "1" Then
        ActiveSheet.Unprotect "123"
        Rows(1).Locked = False
        ActiveSheet.Protect "123"
        Unload Me
    ElseIf TextBox1 = "VELİ" And TextBox2 = "2" Then
        ActiveSheet.Unprotect "123"
        Rows(2).Locked = False
        ActiveSheet.Protect "123"
        Unload Me
    ElseIf TextBox1 = "MEHMET" And TextBox2 = "3" Then
        ActiveSheet.Unprotect "123"
        Rows(3).Locked = False
        ActiveSheet.Protect "123"
        Unload Me
    End If
End Sub

Bir Module içine aşağıdaki kodu ekleyin.

Kod:

Sub auto_open()
    ActiveSheet.Unprotect "123"
    Cells.Locked = True
    ActiveSheet.Protect "123"
End Sub
Sub auto_CLOSE()
    auto_open
End Sub
Sub calis()
    auto_open
    UserForm1.Show 0
End Sub

ThisWorkBook kısmına aşağıdaki kodu ekleyin

Kod:

Private Sub Workbook_Open()
    Application.OnKey "{F12}", "calis"
End Sub

sleeper · 28 Mart 2014

@hamitcan kardeşim klavyene, emeğine sağlık. Gerçekten yardımların için minnettarım. Herşey çok güzel yalnız bir tek sorunum kaldı. Ali'ye tanımladığımız yalnızca 1. satır, fakat benim istediğim sabit bir satır değil, çünkü A sütununa formül yazacağım. Şöyle ki B sütunundaki hücreye Ali'nin sorumlu olduğu bölgeyi yazdığımda A sütununda Ali yazacak, daha sonra Ali B sütununa Veli'nin sorumlu olduğu bölgeyi yazdığında A sütununda otomatik olarak Veli yazacak ve o satırın kontrolü artık Veli'ye geçmiş olacak. Ayrıca A sütunu boş olan satırlara herkes müdahele edebilecek. Biraz komplike bir durum kabul ediyorum ama kodlarla bu işi çözülebileceğine inanıyorum.

hamitcan · 28 Mart 2014

İlgili kodu aşağıdaki ile değiştirin. Form içine yeni bir sorumluluk alanı isimli bir alan koydum, buradan istediğiniz şekilde tanımlama yapabilirsiniz.

Kod:

Private Sub CommandButton1_Click()
    If TextBox1 = "ALİ" And TextBox2 = "1" Then
        ActiveSheet.Unprotect "123"
        Range(TextBox3.Text).Locked = False
        ActiveSheet.Protect "123"
        Unload Me
    ElseIf TextBox1 = "VELİ" And TextBox2 = "2" Then
        ActiveSheet.Unprotect "123"
        Range(TextBox3.Text).Locked = False
        ActiveSheet.Protect "123"
        Unload Me
    ElseIf TextBox1 = "DELİ" And TextBox2 = "3" Then
        ActiveSheet.Unprotect "123"
        Range(TextBox3.Text).Locked = False
        ActiveSheet.Protect "123"
        Unload Me
    End If
End Sub
Private Sub UserForm_Initialize()
    TextBox3 = "a1:a3"
End Sub

sleeper · 28 Mart 2014

Örnek bir excel dosyasını sizinle paylaşmak isterdim fakat üyelik seviyem yeterli değil. O yüzden ekran alıntısı inceleyebilirseniz sevinirim. Çünkü istediğim şeyi daha iyi anlatabildiğime inanıyorum.

hamitcan · 28 Mart 2014

Kısaca ismi A sütunda yazılı olan kişi, o satırda işlem yapabilecek, doğru mu düşünüyorum ?

hamitcan · 28 Mart 2014

Bir de bu şekilde deneyin. A sütunu içinde gezinirken veya bir isim girdiğinizde form otomatik çıkar ve şifre sorar.
Aşağıdaki kodu UserForm1 içine;

Kod:

Private Sub CommandButton1_Click()
    If TextBox1 = "ALİ" And TextBox2 = "1" Then
        ActiveSheet.Unprotect "123"
        Cells.Locked = True
        Rows(ActiveCell.Row).Locked = False
        ActiveSheet.Protect "123"
        Unload Me
    ElseIf TextBox1 = "VELİ" And TextBox2 = "2" Then
        ActiveSheet.Unprotect "123"
        Cells.Locked = True
        Rows(ActiveCell.Row).Locked = False
        ActiveSheet.Protect "123"
        Unload Me
    ElseIf TextBox1 = "DELİ" And TextBox2 = "3" Then
        ActiveSheet.Unprotect "123"
        Cells.Locked = True
        Rows(ActiveCell.Row).Locked = False
        ActiveSheet.Protect "123"
        Unload Me
    End If
End Sub

Aşağıdaki Sayfa1'in kod kısmına ekleyin.

Kod:

Private Sub Worksheet_Change(ByVal Target As Range)
        If Target.Column <> 1 Then Exit Sub
        UserForm1.Show 0
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Column <> 1 Then Exit Sub
    If Target.Count > 1 Then Exit Sub
    If Target = Empty Then
        ActiveSheet.Unprotect "123"
        Cells.Locked = True
        Rows(Target.Row).Locked = False
        ActiveSheet.Protect "123"
    Else
        UserForm1.Show 0
        UserForm1.TextBox1 = Cells(Target.Row, 1)
    End If
End Sub

sleeper · 31 Mart 2014

Şimdide aşağıdaki gibi bir hata verdi, anlamadım malesef.

hamitcan · 31 Mart 2014

Ben bu hatayı almıyorum. Mail adresinizi verirseniz dosyayı gönderebilirim.

sleeper · 1 Nisan 2014

Özel mesaj olarak gönderdim.

Edit: Daha önceden module kısmına ve çalışma sayfası kısmına yazdığım kodları silerek denedim ve hata vermedi. Ama bu şekilde şöyle bir sorunum ortaya çıktı;
"Veli" yazılı hücreye tıkladığımda ve şifreyi girdiğimde sadece o satırda değişiklik yapabiliyorum. Diğer "Veli" yazılı satırlara geldiğimde benden yine şifre istemektedir.

Şu şekilde olabilir mi acaba Hamitcan Bey;

Dosyayı açtığımda direk form açılsın ve kullanıcı adı ile şifreyi girelim. Bir daha şifre sormaya gerek kalmadan A sütununda açılırken girdiğimiz kullanıcı adına ait bütün satırlarda değişiklik yapma yetkisine sahip olabilelim.

hamitcan · 1 Nisan 2014

O hücredeki isim değişince ne olacak ?

sleeper · 1 Nisan 2014

İsim değişince yetkide gitsin istiyorum ama bu ekstra bir zahmet oluşturacaksa yetki o dosyayı kapatana kadar devam edebilir.

hamitcan · 1 Nisan 2014

Bence, form içine tüm "VELİ" yazan hücrelere ait olan satırların şifrelerini aç/kapa şeklinde bir düğme yapılabilir.

hamitcan · 1 Nisan 2014

Kodları tekrar veriyorum.
Module içine;

Kod:

Sub auto_open()
    ActiveSheet.Unprotect "123"
    Cells.Locked = True
    ActiveSheet.Protect "123"
End Sub
Sub auto_CLOSE()
    auto_open
End Sub
Sub calis()
    auto_open
    UserForm1.Show 0
End Sub

Sayfa1'in kod kısmına;

Kod:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column <> 1 Then Exit Sub
    If Target.Count > 1 Then Exit Sub
    If Target.Locked = False Then Exit Sub
    If Target = Empty Then
        ActiveSheet.Unprotect "123"
        Cells.Locked = True
        Rows(Target.Row).Locked = False
        ActiveSheet.Protect "123"
    Else
        UserForm1.Show 0
        UserForm1.TextBox1 = Cells(Target.Row, 1)
    End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Column <> 1 Then Exit Sub
    If Target.Count > 1 Then Exit Sub
    If Target.Locked = False Then Exit Sub
    If Target = Empty Then
        ActiveSheet.Unprotect "123"
        Cells.Locked = True
        Rows(Target.Row).Locked = False
        ActiveSheet.Protect "123"
    Else
        UserForm1.Show 0
        UserForm1.TextBox1 = Cells(Target.Row, 1)
    End If
End Sub

ThisWorkBook kısmına

Kod:

Private Sub Workbook_Open()
    Application.OnKey "{F12}", "calis"
End Sub

UserForm içine

Kod:

Private Sub CommandButton1_Click()
If CheckBox1 Then SatirAc TextBox1.Text: Exit Sub
If CheckBox2 Then SatirKapat: Exit Sub
    If TextBox1 = "ALİ" And TextBox2 = "1" Then
        ActiveSheet.Unprotect "123"
        Cells.Locked = True
        Rows(ActiveCell.Row).Locked = False
        ActiveSheet.Protect "123"
        Unload Me
    ElseIf TextBox1 = "VELİ" And TextBox2 = "2" Then
        ActiveSheet.Unprotect "123"
        Cells.Locked = True
        Rows(ActiveCell.Row).Locked = False
        ActiveSheet.Protect "123"
        Unload Me
    ElseIf TextBox1 = "DELİ" And TextBox2 = "3" Then
        ActiveSheet.Unprotect "123"
        Cells.Locked = True
        Rows(ActiveCell.Row).Locked = False
        ActiveSheet.Protect "123"
        Unload Me
    End If
End Sub
Private Sub SatirAc(Isim)
        ActiveSheet.Unprotect "123"
        Cells.Locked = True
    For i = 1 To [a65536].End(3).Row
        If Isim = Cells(i, 1) Then Rows(i).Locked = False
    Next
        ActiveSheet.Protect "123"
        MsgBox "Satırlar Açılmıştır."
        Unload Me
End Sub
Private Sub SatirKapat()
        ActiveSheet.Unprotect "123"
        Cells.Locked = True
        ActiveSheet.Protect "123"
        MsgBox "Satırlar Kapatılmıştır."
        Unload Me
End Sub

sleeper · 2 Nisan 2014

Allah razı olsun gerçekten çok yardımcı oldunuz. Memnuniyetsiz olarak görmezseniz beni eğer son bir sıkıntım daha kaldığını söylemem gerek. Mail olarak yolladığınız dosyada userforma "ALİ" yazdıktan sonra şifre kısmına "1"de yazsam başka bir şey de yazsam "Tüm Satırları Aç"ı işaretlediğim taktirde "ALİ" yazılı tüm satırlar açılıyor. Aynı şey haliyle diğer kullanıcılarda da geçerli.

hamitcan · 2 Nisan 2014

İlgili kodu aşağıdaki ile değiştirip dener misiniz ? Bu arada kodu daha da geliştirmek mümkün.

Kod:

Private Sub CommandButton1_Click()
    If TextBox1 = "ALİ" And TextBox2 = "1" Then
    If CheckBox1 Then SatirAc TextBox1.Text: Exit Sub
    If CheckBox2 Then SatirKapat: Exit Sub
        ActiveSheet.Unprotect "123"
        Cells.Locked = True
        Rows(ActiveCell.Row).Locked = False
        ActiveSheet.Protect "123"
        Unload Me
    ElseIf TextBox1 = "VELİ" And TextBox2 = "2" Then
    If CheckBox1 Then SatirAc TextBox1.Text: Exit Sub
    If CheckBox2 Then SatirKapat: Exit Sub
        ActiveSheet.Unprotect "123"
        Cells.Locked = True
        Rows(ActiveCell.Row).Locked = False
        ActiveSheet.Protect "123"
        Unload Me
    ElseIf TextBox1 = "DELİ" And TextBox2 = "3" Then
    If CheckBox1 Then SatirAc TextBox1.Text: Exit Sub
    If CheckBox2 Then SatirKapat: Exit Sub
        ActiveSheet.Unprotect "123"
        Cells.Locked = True
        Rows(ActiveCell.Row).Locked = False
        ActiveSheet.Protect "123"
        Unload Me
    Else
        MsgBox "Hatalı Kullanıcı Yada Şifre": Unload Me
    End If
End Sub

catkapi · 2 Nisan 2014

Emeğe saygı Çok teşekkürler

sleeper · 3 Nisan 2014

İşte şimdi herşey süper oldu. Emeğine sağlık. Gerçekten çok minnettarım.

Koşullu Satır Kilitleme

sleeper

hamitcan

Uzman

sleeper

hamitcan

Uzman

Ekli dosyalar

sleeper

hamitcan

Uzman

Ekli dosyalar

sleeper

hamitcan

Uzman

hamitcan

Uzman

Ekli dosyalar

sleeper

hamitcan

Uzman

sleeper

hamitcan

Uzman

sleeper

hamitcan

Uzman

hamitcan

Uzman

Ekli dosyalar

sleeper

hamitcan

Uzman

catkapi

sleeper