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