Fout passwoord ingeven moet code afgebroken worden

[bjornesto]

Ik heb een code gemaakt en zou graag hebben als het passwoord fout is dat dan de private sub afsluit zodat je niet verder kan gaan naar de volgende msgbox. Hoe moet ik dat dan aanpassen?

Private Sub CommandButton2_Click()
Dim mypassword
tryagain:
mypassword = InputBox("Enter Password", "Password")
If mypassword = "yourpassword" Then

'your code here
MsgBox ("Correct")
Else
If MsgBox("Password incorrect, try again?", vbYesNo, "Wrong password") = vbYes Then GoTo tryagain
End If
If MsgBox("Are you sure that you wish to clear the contents?", vbYesNo, "Confirm") = vbYes Then
    Range("A3").Select
    Selection.SpecialCells(xlCellTypeConstants, 1).Select
    Selection.ClearContents
End If
End Sub

 

[rebmog]

Dat kan bijvoorbeeld als volgt. Er is daarbij ook een teller ingebouwd waarbij na 3 pogingen de procedure wordt afgebroken.

Private Sub CommandButton2_Click()
    Dim mypassword
    Dim teller As Integer
    teller = 1
tryagain:
    mypassword = InputBox("Enter Password", "Password")
    If mypassword = "yourpassword" Then
        'your code here
        MsgBox ("Correct")
    ElseIf teller = 3 Then
        MsgBox "Exit", vbOKOnly
        Exit Sub
    Else
        If MsgBox("Password incorrect, try again?", vbYesNo, "Wrong password") = vbYes Then
            teller = teller + 1
            GoTo tryagain
        End If
    End If
    If MsgBox("Are you sure that you wish to clear the contents?", vbYesNo, "Confirm") = vbYes Then
        Range("A3").Select
        Selection.SpecialCells(xlCellTypeConstants, 1).Select
        Selection.ClearContents
    End If
End Sub

Rebmog

 

[bjornesto]

Het probleem is nog steeds hetzelfde

Als ik een juist antwood intik zou ik naar de volgende messagebox moeten gaan die in de code staat

If MsgBox("Are you sure that you wish to clear the contents?", vbYesNo, "Confirm") = vbYes Then
    Range("A3").Select
    Selection.SpecialCells(xlCellTypeConstants, 1).Select
    Selection.ClearContents
End If

Als ik echter een fout paswoord geef en kies voor no dan moet die gewoon sluiten.
Momenteel gaat als je op no klikt nog altijd verder door naar de messagebox hierboven om cellen te deleten

 

[rebmog]

De keuze van No bij een foutief password had ik over het hoofd gezien. Hierbij een aangepaste versie.

Private Sub CommandButton2_Click()
    Dim mypassword
    Dim teller As Integer
    teller = 1
tryagain:
    mypassword = InputBox("Enter Password", "Password")
    If mypassword = "yourpassword" Then
        'your code here
        MsgBox ("Correct")
    ElseIf teller = 3 Then
        MsgBox "Exit", vbOKOnly
        Exit Sub
    Else
        If MsgBox("Password incorrect, try again?", vbYesNo, "Wrong password") = vbYes Then
            teller = teller + 1
            GoTo tryagain
        Else
            Exit Sub
        End If
    End If
    If MsgBox("Are you sure that you wish to clear the contents?", vbYesNo, "Confirm") = vbYes Then
        Range("A3").Select
        Selection.SpecialCells(xlCellTypeConstants, 1).Select
        Selection.ClearContents
    End If
End Sub

Rebmog

 

[bjornesto]

Nu werkt het wel

Dank u hiervoor

 

[Warme bakkertje]

Val je gebruiker niet lastig met een overdaad aan aan te klikken objecten.

Private Sub CommandButton2_Click()
    Dim mypassword As String, terller As Integer
    teller = 0
    Do
        mypassword = Application.InputBox("Enter Password - 3 wrong passwords closes this box.", "Password", "Attempt " & teller + 1, , , , , 2)
        teller = teller + 1
    Loop Until mypassword = "yourpassword" Or teller = 3
    If mypassword <> "yourpassword" Then Exit Sub
    If MsgBox("Are you sure that you want to clear the contents?", vbYesNo, "Confirm") = vbYes Then
        Cells(3, 1).SpecialCells(xlCellTypeConstants, 1).ClearContents
    End If
End Sub