Aşağıdaki kodlarla userformda kullanıcı adı ve şifre girerek excel gtiriş yapmaktayım.
Ancak, şifre veya kulanıcı adınada hata olduğunda Label1 de "Parola Yanlış Girildi Tekrar Deneyiniz" mesajı çıkmakta
Başarılı giriş yapılması halinde de label1 "Hoş geldiniz" mesajınız çıkmasını istiyorum.
Private Sub cmdCheck_Click()
Dim AddData As Range, Current As Range
Dim user As Variant, Code As Variant
Dim PName As Variant, AName As Variant
Dim ws As Worksheet, ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet, ws5 As Worksheet
Dim result As Integer
Dim TitleStr As String
Dim msg As VbMsgBoxResult
user = Me.txtuser.Value
Code = Me.txtpass.Value
TitleStr = "Parola kontrolü"
result = 0
Set Current = Sayfa5.Range("K2")
Application.Caption = "AKTİF KULLANICI : " & user
Set AddData = Sayfa5.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0)
If user <> "" And Not IsNumeric(user) And Code <> "" And IsNumeric(Code) Then
For Each AName In Sayfa5.Range("G2:G100")
If AName = CLng(Code) And AName.Offset(0, -1) = user Then
MsgBox " HOŞGELDİNİZ SAYIN: " & user
AddData.Value = user
AddData.Offset(0, 1).Value = Now
Current.Value = user
result = 1
Sayfa1.Visible = True
Sayfa1.Select
Exit Sub
End If
Next AName
End If
If user <> "" And Not IsNumeric(user) And Code <> "" And IsNumeric(Code) Then
For Each PName In Sayfa5.Range("H2:H100")
If PName = CLng(Code) And PName.Offset(0, -1) = user Then
MsgBox "HOŞ GELDİ NİZ SAYIN: " & user
AddData.Value = user
AddData.Offset(0, 1).Value = Now
Current.Value = user
If PName.Offset(0, 1) <> "" Then
Set ws = Worksheets(PName.Offset(0, 1).Value)
ws.Visible = True
End If
If PName.Offset(0, 2) <> "" Then
Set ws5 = Worksheets(PName.Offset(0, 2).Value)
ws5.Visible = True
End If
ActiveWindow.DisplayWorkbookTabs = True
result = 1
Sheets("Liste").Visible = 1
Sheets("Liste").Activate
Unload Me
Exit Sub
End If
Next PName
End If
Label1.Visible = 1
Label2.Visible = 1
Label2 = Label2 + 1
txtpass.SetFocus
If result = 0 Then
Trial = Trial + 1
userform2.Label1.Caption = "Parola Yanlış Girildi Tekrar Deneyiniz:" & user
If Trial < 3 Then msg = MsgBox("Yanlış bir şifre, lütfen tekrar deneyin", vbExclamation + vbOKOnly, TitleStr)
Me.txtuser.SetFocus
If Trial = 3 Then
msg = MsgBox("Yanlış şifre, form kapanacak ...", vbCritical + vbOKOnly, TitleStr)
ActiveWorkbook.Close False
End If
End If
End sub
Exit Sub
Ancak, şifre veya kulanıcı adınada hata olduğunda Label1 de "Parola Yanlış Girildi Tekrar Deneyiniz" mesajı çıkmakta
Başarılı giriş yapılması halinde de label1 "Hoş geldiniz" mesajınız çıkmasını istiyorum.
Private Sub cmdCheck_Click()
Dim AddData As Range, Current As Range
Dim user As Variant, Code As Variant
Dim PName As Variant, AName As Variant
Dim ws As Worksheet, ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet, ws5 As Worksheet
Dim result As Integer
Dim TitleStr As String
Dim msg As VbMsgBoxResult
user = Me.txtuser.Value
Code = Me.txtpass.Value
TitleStr = "Parola kontrolü"
result = 0
Set Current = Sayfa5.Range("K2")
Application.Caption = "AKTİF KULLANICI : " & user
Set AddData = Sayfa5.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0)
If user <> "" And Not IsNumeric(user) And Code <> "" And IsNumeric(Code) Then
For Each AName In Sayfa5.Range("G2:G100")
If AName = CLng(Code) And AName.Offset(0, -1) = user Then
MsgBox " HOŞGELDİNİZ SAYIN: " & user
AddData.Value = user
AddData.Offset(0, 1).Value = Now
Current.Value = user
result = 1
Sayfa1.Visible = True
Sayfa1.Select
Exit Sub
End If
Next AName
End If
If user <> "" And Not IsNumeric(user) And Code <> "" And IsNumeric(Code) Then
For Each PName In Sayfa5.Range("H2:H100")
If PName = CLng(Code) And PName.Offset(0, -1) = user Then
MsgBox "HOŞ GELDİ NİZ SAYIN: " & user
AddData.Value = user
AddData.Offset(0, 1).Value = Now
Current.Value = user
If PName.Offset(0, 1) <> "" Then
Set ws = Worksheets(PName.Offset(0, 1).Value)
ws.Visible = True
End If
If PName.Offset(0, 2) <> "" Then
Set ws5 = Worksheets(PName.Offset(0, 2).Value)
ws5.Visible = True
End If
ActiveWindow.DisplayWorkbookTabs = True
result = 1
Sheets("Liste").Visible = 1
Sheets("Liste").Activate
Unload Me
Exit Sub
End If
Next PName
End If
Label1.Visible = 1
Label2.Visible = 1
Label2 = Label2 + 1
txtpass.SetFocus
If result = 0 Then
Trial = Trial + 1
userform2.Label1.Caption = "Parola Yanlış Girildi Tekrar Deneyiniz:" & user
If Trial < 3 Then msg = MsgBox("Yanlış bir şifre, lütfen tekrar deneyin", vbExclamation + vbOKOnly, TitleStr)
Me.txtuser.SetFocus
If Trial = 3 Then
msg = MsgBox("Yanlış şifre, form kapanacak ...", vbCritical + vbOKOnly, TitleStr)
ActiveWorkbook.Close False
End If
End If
End sub
Exit Sub