UzerForm üzerinden kayti sifre ile engellemek

[kaleci]

Sayin Hocalarim,

Leventm Hocam’in ellerine saglik asagidaki Linkte(http://www.excel.web.tr/showthread.php?t=20156)
yazmis oldugu kod ile bana cok yardimci oldu. Kendisine cok tesekkür ederim.

Hocam sorunu yazdigi kod ile söyle cözdü: Sayfa üzerinden herhangi bir hücreye giris yapmak istedigimiz zaman, bizden „sifre“ istiyor.

Ayni kod ile UserForm üzerinden sayfaya kayit yapilmak istedigimdede „sifre“ istettirebilirmiyiz? Yoksa bu mümkün degil mi?
Su anda UserForm üzerinden sifresiz olarak kaydediliyor.

Arkadaslar asagidaki gibi bir denerseniz, hemen ne demek istedigim, gözünüze takilacaktir.

Sayfada
"Daten-Eingabe" denilen buttona tiklayip,
ComboBox'tan bir isim secip,
Takvimden izin baslangic tarihine (02.01.2006) ve izin bitis tarihlerine (09.01.2006) tiklayip,
CheckBoxtaki "Urlaub= U" buttonuna tikladigimizda, sayfaya hala kayit yapiyor.

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, [m3339]) 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


Saygilarimla
kaleci

 

[kaleci]

Sayin Leventm Hocam,

Asagidaki yazmis oldugunuz Kod ile bana cok yardimci olmustunuz. Ama sifreyi InputBox 'a yazarken yazilan sifre görünüyordu. Bu Problemi Almanca bir Formdaki Uwe Küstner isimli arkadas UserForm üzerinden cözdü. Kendisne cok tesekkürler.


Paylasim icin Kodu gönderiyorum

1. Kod: Sayfaya yazilacak
Kod:
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim Kennwort As String
If Not Application.Intersect(Target, Me.Range("e3:h339")) Is Nothing Then
Kennwort = "mm1"
ElseIf Not Application.Intersect(Target, Me.Range("i3:l339")) Is Nothing Then
Kennwort = "mm2"
ElseIf Not Application.Intersect(Target, Me.Range("m3339")) Is Nothing Then
Kennwort = "mm3"
ElseIf Not Application.Intersect(Target, Me.Range("q3:t339")) Is Nothing Then
Kennwort = "mm4"
ElseIf Not Application.Intersect(Target, Me.Range("u3:w339")) Is Nothing Then
Kennwort = "mm5"
ElseIf Not Application.Intersect(Target, Me.Range("x3:ac339")) Is Nothing Then
Kennwort = "mm6"
Else
Exit Sub
End If
If Kennwort = PasswordAbfrage Then Exit Sub
MsgBox "Kennwort falsch!!!"
Me.Range("A1").Select
End Sub


2. Kod: UserForm' a yazilacak, 2 tane CommandButton ve 1 tane de TextBox UserForm' a eklenecek.
Kod:
'Modul UserForm1 (Einfügen - Userform)
Private Sub CommandButton1_Click()
'OK-Button
Me.Hide
End Sub

Private Sub CommandButton2_Click()
'Abbrechen-Button
Unload Me
End Sub

Private Sub UserForm_Initialize()
'Anzeige der Textbox einstellen.
'Das kann auch direkt im VBA-Editor
'eingestellt werden. Dann kann
'diese Sub entfallen.
Me.TextBox1.PasswordChar = "*"
End Sub


3. Kod: Modul kismina yazilacak
Kod:
Sub DeinMakro()
Dim Fragen As String
Fragen = PasswordAbfrage
MsgBox Fragen
End Sub

'-----------------------------------------------
'in einem allgemeinen Modul (Einfügen - Modul)
Public Function PasswordAbfrage() As String
UserForm1.Show
PasswordAbfrage = UserForm1.TextBox1
Unload UserForm1
End Function
End Sub

kaleci