Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1684to1688
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Neues Passwort vergeben mit Prüfen

Neues Passwort vergeben mit Prüfen
13.04.2019 21:51:56
BLangmantl
Hallo,
in beiligender Tabelle gibt es wenn man sich einloggt ein Controlpanel, mit auf diesem findet man einen Button, der dem User ermöglicht, sein Passwort zu ändern.
Es geht das Formular frm_NewPassowrd. Dort wird bereits beim öffnen das aktuelle Passwort aus der Tabelle wo es drinsteht in die txt_OldPW geschrieben.
Es gibt in diesem Formular auch noch zwei Textboxen wo das neue Passwort eingegeben werden kann und zur Kontrolle ein zweites Mal eingegeben werden soll.
Jetz was ich will:
Bei drücken auf den Button neu setzen, dieser darf nur aktiviert sein, soll er zum einen Prüfen, ob das beide neu eingegebenen passworter, also das neue und das zur Kontrolle ein zweites mal eingegebene übereinstimmt. zusätzlich darf das neue nicht mit dem bereits vergebenen Passwort übereinstimmen. Wie geht das.
In die Tabelle muss man sich, damit man damit arbeiten kann einloggen, dort loggt man sich in die Datei ein mit dem Benutzernamen und dem Passwort, das auf der Startseite angegeben ist.
https://www.herber.de/bbs/user/129132.xlsm
Schon einmal danke für die Hilfe

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Neues Passwort vergeben mit Prüfen
14.04.2019 07:42:54
Sepp
Hallo Benedikt,
Private Sub btn_PWSet_Click()

  If txt_NewPW <> txt_OldPW Then
    If Len(txt_NewPW) Then
      If txt_NewPW = txt_NewPWReapeat Then
        'hier dein Code zum Übernehmen des neuen Passwortes 
      Else
        Call MsgBox("Die Wiederholung des neuen Passwortes ist falsch!", vbExclamation)
        txt_NewPWReapeat = ""
        txt_NewPWReapeat.SetFocus
      End If
    Else
      Call MsgBox("Das neue Passwort ist ungültig!", vbExclamation)
      txt_NewPW.SetFocus
    End If
  Else
    Call MsgBox("Das neue Passwort darf nicht dem alten Passwort entsprechen!", vbExclamation)
    txt_NewPW = ""
    txt_NewPWReapeat = ""
    txt_NewPW.SetFocus
  End If
End Sub

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media

Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0


Anzeige
AW: Neues Passwort vergeben mit Prüfen
14.04.2019 17:17:41
fcs
Hallo,
ich hab den Code in dem Userform frm_Newpassword ergänzt/angepasst.
Damit ich die Steuerelemente schrittweise auf "Aktiv" und per Makro den Fokus setzen konnte hab ich die Eigenschaft "TabIndex" auch teilweise geändert.
Zusätzlich hab ich den Code für Schaltfläche "passwort ändern" im Form "frm_ControlPanel" angepasst, damit der Ablauf gesteuert werden kann, wenn das Startpasswort nicht geädert wurde.
https://www.herber.de/bbs/user/129142.xlsm
LG
Franz
AW: Neues Passwort vergeben mit Prüfen
15.04.2019 13:45:23
BLangmantl
Hallo Sepp,
danke für deinen Ansatz, kannst du mir bitte noch sagen, wie man aprüft, ob das Passwort aus Zahlen und Buchstaben besteht und oder aus Zahlen, Buchstaben und Sonderzeichen.
Es darf nicht erlaubt werden: Nur Buchstaben, Nur Zahlen
Anzeige
AW: Neues Passwort vergeben mit Prüfen
15.04.2019 14:13:58
Rudi
Hallo,
Private Sub btn_PWSet_Click()
Dim i As Integer, blnZahl As Boolean, blnBuchstabe As Boolean
If txt_NewPW  txt_OldPW Then
If Len(txt_NewPW) Then
If txt_NewPW = txt_NewPWReapeat Then
For i = 1 To Len(txt_NewPW)
If IsNumeric(Mid(txt_NewPW, i, 1)) Then
blnZahl = True
Else
blnBuchstabe = True
End If
Next i
If blnZahl And blnBuchstabe Then
'hier dein Code zum Übernehmen des neuen Passwortes
Else
MsgBox "Es müssen Buchstaben und Zahlen vorhanden sein!", , "Gebe bekannt..."
txt_NewPW.SetFocus
End If
Else
Call MsgBox("Die Wiederholung des neuen Passwortes ist falsch!", vbExclamation)
txt_NewPWReapeat = ""
txt_NewPWReapeat.SetFocus
End If
Else
Call MsgBox("Das neue Passwort ist ungültig!", vbExclamation)
txt_NewPW.SetFocus
End If
Else
Call MsgBox("Das neue Passwort darf nicht dem alten Passwort entsprechen!", vbExclamation)
txt_NewPW = ""
txt_NewPWReapeat = ""
txt_NewPW.SetFocus
End If
End Sub

Gruß
Rudi
Anzeige
AW: Neues Passwort vergeben mit Prüfen
15.04.2019 15:44:59
Benedikt
hallo Rudi,
danke für den Ansatz, aber der Franz hat mir das Formular schon soweit geändert, dass die Anzeige, dass das Passwort nicht dem alten entsprechen darf schon gebaut, das möchte ich nicht ändern. Die Passowrtprüfung findet auch über eine Funktion ein,
kann man die Abbprüfung denn nicht in die Funktion mit integrieren?
Hier die Codes
Option Explicit
'*********************************************************************************
'* Berlin Neuköllner Karnevalsgesellschaft von 1950 e.V. "Fidele Rixdorfer" *
'* Programmierung von BeLaBe Webservice *
'* Glasower Str. 53; 12051 Berlin *
'* mail@belabe-web.de *
'* © 2018 BNKG Fidele Rixdorfer *
'* Es wird hier den Helfern gedankt, die bei der Entwicklung mitgeholfen haben: *
'* Franz Sielck, ChrisL, fcs *
'*********************************************************************************
Private rngUser As Range 'fcs 2019-04-14
Private Sub btn_Close_Click()
Me.Tag = "PW nicht geaendert"
Me.Hide
End Sub
Private Sub btn_PWSet_Click()
'fcs 2019-04-14
rngUser.Offset(0, 1).Value = Me.txt_NewPW
rngUser.Offset(0, 2).Value = 1
With Login
Call Blattschutz_Aus
.Range("E:E").EntireColumn.AutoFit
Call Blattschutz_An
End With
Me.Tag = "PW geaendert"
Me.Hide
MsgBox "Passwort wurde geändert", vbOKOnly + vbInformation, "Passwort ändern"
End Sub

Private Function fncCheckPassword(ByVal strText As String) As Boolean    'fcs 2019-04-14
Dim strMsgText As String
fncCheckPassword = True
If Len(strText)  "" Then
fncCheckPassword = False
MsgBox "Die Syntax für das Passwort ist nicht korrekt" & vbLf & vbLf & strMsgText, _
vbOKOnly + vbInformation, "Prüfung Passwort"
End If
End Function

Private Sub txt_NewPW_Enter()                                               'fcs 2019-04-14
Me.txt_NewPW = ""
Me.txt_NewPWReapeat = ""
Me.txt_NewPWReapeat.Enabled = False
Me.btn_PWSet.Enabled = False
End Sub

Private Sub txt_NewPW_Exit(ByVal Cancel As MSForms.ReturnBoolean)           'fcs 2019-04-14
If Me.txt_NewPW = "" Then
'keine Aktion - Textbox kann verlassen werden
ElseIf Me.txt_NewPW = Me.txt_OldPW Then
MsgBox "Das alte Startpasswort/alte Passwort darf nicht verwendet werden!." & vbLf & " _
Bitte Ändern.", _
vbOKOnly + vbInformation, "Passwort ändern"
Me.txt_NewPW = ""
Cancel = True
Else
If fncCheckPassword(Me.txt_NewPW.Text) = True Then
Me.txt_NewPWReapeat.Enabled = True
Me.txt_NewPWReapeat.SetFocus
Else
Me.txt_NewPW = ""
Cancel = True
End If
End If
End Sub

Private Sub txt_NewPWReapeat_Exit(ByVal Cancel As MSForms.ReturnBoolean)    'fcs 2019-04-14
If Me.txt_NewPW = "" Then
'keine Aktion - Textbox kann verlassen werden
ElseIf Me.txt_NewPW  txt_NewPWReapeat Then
MsgBox "Die Wiederholung stimmt mit dem neuen Passwort nicht überein!." & vbLf & "Bitte  _
Ändern.", vbOKOnly + vbInformation, "Passwort ändern"
Me.txt_NewPWReapeat = ""
Cancel = True
Else
Me.btn_PWSet.Enabled = True
Me.btn_PWSet.SetFocus
End If
End Sub

Private Sub UserForm_Initialize()
Dim objObject As Object
Dim strUsername As String
strUsername = Vereinsstatus.Range("N1")
Set rngUser = Login.Range("D:D").Find(what:=strUsername, LookIn:=xlValues, lookat:=xlWhole,  _
MatchCase:=True)
With Me
.Caption = strTiFo
.lbl_Copywright.Caption = strCwFo
.txt_OldPW.Locked = True    'fcs 2019-04-14
.txt_NewPW.SetFocus         'fcs 2019-04-14
.btn_PWSet.Enabled = False  'fcs 2019-04-14
For Each objObject In Me.Controls
If Left(objObject.Name, 3) = "btn" Or Left(objObject.Name, 3) = "txt" Then
objObject.ForeColor = vbBlue
If Left(objObject.Name, 3) = "btn" Then
objObject.BackColor = vbYellow
End If
End If
Next
Select Case rngUser.Offset(0, 2).Value
Case Is = "0"
.lbl_OldPW.Caption = "Startpasswort"
End Select
txt_OldPW = rngUser.Offset(0, 1).Value
End With
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = 0 Then 'user clickt Schliessen-X
Cancel = True
Call btn_Close_Click
End If
End Sub

Anzeige
AW: Neues Passwort vergeben mit Prüfen
16.04.2019 00:50:59
fcs
Hallo Benedikt,
hier die Function ergänzt um die von Sepp geschriebenen Anweisungen zur Prüfung auf Zahlen/Buchstaben.

Private Function fncCheckPassword(ByVal strText As String) As Boolean    'fcs 2019-04-14
Dim strMsgText As String
Dim blnZahl As Boolean, blnBuchstabe As Boolean
fncCheckPassword = True
If Len(strText)  "" Then
fncCheckPassword = False
MsgBox "Die Syntax für das Passwort ist nicht korrekt" & vbLf & vbLf & strMsgText, _
vbOKOnly + vbInformation, "Prüfung Passwort"
End If
End Function

LG
Franz
AW: Neues Passwort vergeben mit Prüfen
16.04.2019 11:06:34
BLangmantl
Vielen Dank Franz funktioniert gut
@Sepp
Darf ich deinen Namen auch im Copywright erwähnen?
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige