UserForm1' e sifreyi sayfa2 den okuyabilirmiyiz?

[kaleci]

Sayin Hocalarim,

Asagidaki dosyada gerekli aciklamayi yaptim, eger yapilmasi mümkünse cok isime yarayacak. Program simdi problemsiz calisiyor ama sifreyi degistirmek istedigim zaman, her defasinda VBA' ya girmek istemiyorum. Bir incelerseniz com memnun olurum.

Saygilarimla
kaleci

 

[kaleci]

Sayin Hamitcan hocam,

ellerine saglik CheckBox(izin) tam istedigim gibi olmus.
Problemimin birtanesini cözdünüz.

Hocam agidaki kod ilede sayfa1' deki herhangi bir hücreye tikladigimda UserForm1 penceresi aciliyor ve yine sifreyi soruyor.
Sayfa1'e tikladigimizda sifreleri Sayfa2 den nasil okutturabiliriz, aynen "izin" buttonda oldugu gibi.

Kod: Sayfa1 de
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim NeuesKennwort As String
Static AltesKennwort As String
On Error GoTo Ende
Application.EnableEvents = False
If Not Application.Intersect(Target, Me.Range("B2:F31")) Is Nothing Then
NeuesKennwort = "test1"
Application.Intersect(Target, Me.Range("B2:F31")).Select
ElseIf Not Application.Intersect(Target, Me.Range("G2:K31")) Is Nothing Then
NeuesKennwort = "test2"
Application.Intersect(Target, Me.Range("G2:K31")).Select
Else
Application.EnableEvents = True
Exit Sub
End If
Ende:
Application.EnableEvents = True
If NeuesKennwort = AltesKennwort Then Exit Sub
If NeuesKennwort = PasswordAbfrage Then
AltesKennwort = NeuesKennwort
Exit Sub
End If
MsgBox "Yanlis sifre girdiniz!!!"
Me.Range("A1").Select
End Sub


Saygilarimla
kaleci

 

[kaleci]

Sayin Hamitcan hocam,

Sizin yazdiginiz koda bakarak bende asagidaki degisikligi yaptim ve tam istedigim gibi oldu. Gösterdiginiz yoldan dolayi tesekkür ederim.

Saygilarimla
Balci

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim NeuesKennwort As String
Static AltesKennwort As String
On Error GoTo Ende
Set s2 = Tabelle2
Application.EnableEvents = False
If Not Application.Intersect(Target, Me.Range("B2:F31")) Is Nothing Then
NeuesKennwort = (s2.[c2])
Application.Intersect(Target, Me.Range("B2:F31")).Select
ElseIf Not Application.Intersect(Target, Me.Range("G2:K31")) Is Nothing Then
NeuesKennwort = (s2.[c3])
Application.Intersect(Target, Me.Range("G2:K31")).Select
Else
Application.EnableEvents = True
Exit Sub
End If
Ende:
Application.EnableEvents = True
If NeuesKennwort = AltesKennwort Then Exit Sub
If NeuesKennwort = PasswordAbfrage Then
AltesKennwort = NeuesKennwort
Exit Sub
End If
MsgBox "Yanlis sifre girdiniz!!!"
Me.Range("A1").Select
End Sub

 

[hamitcan]

Aşağıdaki şekilde dener misiniz?

Private Sub izin_Click()
Dim Kennwort As Variant
If izin Then
izin.Value = False
If ComboBox1 = "" Then
MsgBox "Isim giriniz!", vbCritical
Exit Sub
End If
If TextBox1 = "" Or TextBox2 = "" Then
MsgBox "Tarih giriniz!", vbCritical
Exit Sub
End If
tarih1 = TextBox1 'veya DTPicker1
tarih2 = TextBox2 'veya DTPicker2
bul1 = Range("A2:A31").Find(tarih1, LookIn:=xlValues).Row
bul2 = Range("A2:A31").Find(tarih2, LookIn:=xlValues).Row
Set s2 = Tabelle2
Kennwort = Array(s2.[b2], s2.[b3], s2.[b4], s2.[b5], s2.[b6], _
s2.[b7], s2.[b8], s2.[b9], s2.[b10], s2.[b11])
If Kennwort(ComboBox1.ListIndex - 1) = PasswordAbfrage Then
Range(Cells(bul1, sutun), Cells(bul2, sutun)).Interior.ColorIndex = 4
Else
MsgBox "Sifre yanlis!!!"
End If
End If

End Sub