Makro, hilfe zu abbruch

[JJürgen]

hallo Leute,
hab ein User anmelde Formular erstellt, funk so weit, aber wenn Benutzer oder Passwort falsch ist soll es noch ein 2. Versuch geben und danach Userform schließen und keine Aktion durchführen. Hilfe wäre nett 
Dank voraus
Gruß Jürgen

[Andreas Killer]

Hallo Jürgen,

ersetze den Code in der Form mit dem Code unten. Was da in Bezahlen passiert habe ich mir nicht angeschaut.

Andreas.

Code:

Option Explicit

Dim PwdCounter As Integer

Private Sub CBAnmelden_Click()
  Dim Table As ListObject
  Dim uName As Range, uPwd As Range

  Set Table = Worksheets("LogIn-Daten").ListObjects("tblPWKassierer")
  Set uName = Table.ListColumns("Name").DataBodyRange.Find(Me.txtBenutzername, LookIn:=xlValues, LookAt:=xlWhole)
  If uName Is Nothing Then
    MsgBox "Benutzer nich vorhande,Du hast keine Zugangsrechte", vbCritical
    Exit Sub
  End If

  Set uPwd = Intersect(Table.ListColumns("Passwort").DataBodyRange, uName.EntireRow)
  If StrComp(uPwd, Me.txtPasswort) <> 0 Then
    PwdCounter = PwdCounter + 1
    Select Case PwdCounter
      Case 1
        MsgBox "Passwort nicht korrekt, noch ein Versuch"
        Exit Sub
      Case 2
        MsgBox "Passwort nicht korrekt, das wars"
        Unload Me
        Exit Sub
    End Select
  End If

  'Fall 3:Passwort stimmt
  Me.Hide
  Call Bezahlen
  Unload Me
End Sub

Sub Bezahlen()
  ActiveSheet.Unprotect
  If Range("Q5").Value = "" Then
    Range("Q5").Value = Me.txtBenutzername
    Exit Sub
  End If

  Dim arrBezahlen, iCnt%
  arrBezahlen = Worksheets("Bonkasse").Range("n10:T35").Value
  iCnt% = 1

  With Sheets("Buchung").ListObjects("tblBuchung").DataBodyRange
    Do While arrBezahlen(iCnt, 1) <> ""
      .Cells(arrBezahlen(iCnt, 1), 9) = "ja"
      .Cells(arrBezahlen(iCnt, 1), 12) = Range("Q5").Value
      iCnt = iCnt + 1
    Loop
  End With

  Range("Q5").Select

  With Selection.Interior
    .Pattern = xlNone
    .TintAndShade = 0
    .PatternTintAndShade = 0
  End With

  Range("Q3,Q5").Select
  Selection.ClearContents
  ActiveSheet.Protect
  Shell ("C:\Users\info\Documents\Kassentools\Kassenlade\NeueSchublade3.exe")
End Sub

[slowboarder]

Hi

mal so als Ansatz.

ich habe, um den Code etwas zu vereinfachen und den Ablauf stringenter zu machen, die Prüfung mit ZählenWenns gemacht.
damit kann man Benutzer und Passwort gleichzeitig prüfen.
ich hoffe mal, du kannst verschmerzen, dass jetzt die Groß/Kleinschreibung nicht mehr relevant ist:

Code:

Dim Anzahl_Versuche As Long
Const Max_Anzahl_Versuche = 2

Private Sub CBAnmelden_Click()

'Varialen definieren
Dim user As String
Dim pw As String
Dim Meldung As String

'Wert zuweisen
user = Me.txtBenutzername.Text
pw = Me.txtPasswort.Text

Anzahl_Versuche = Anzahl_Versuche + 1

If WorksheetFunction.CountIfs(Worksheets("LogIn-Daten").Range("A:A"), user, Worksheets("LogIn-Daten").Range("b:b"), pw) > 0 Then
    Anzahl_Versuche = 0
    Me.Hide
    Call Bezahlen
   
Else
   If WorksheetFunction.CountIf(Worksheets("LogIn-Daten").Range("A:A"), user) = 0 Then
        Meldung = "Benutzer nicht vorhanden."
    Else
        Meldung = "Passwort falsch."
    End If
   
    If Anzahl_Versuche <= Max_Anzahl_Versuche Then
        MsgBox Meldung & vbLf & "Versuche es nochmal", vbInformation
    Else
        MsgBox Meldung & vbLf & "Anzahl Versuche überschritten!", vbCritical
        Unload Me
    End If
End If



End Sub

Gruß Daniel

[JJürgen]

Hallo Andreas, funktioniert nur mit Passwort, wenn Benutzer falsch dann quasi endlosschleife.
so geht es auch,
mit dem Code Bezahlen ist klar, ist ja nur eine Testmappe und daher werden die Daten auch nicht gefunden.

Danke

---

Hallo Daniel, deine Version klappt prima,
so mach mich mal jetzt schlau was da im code passiert, und versuche es zu verstehen.
Danke