Passwort und Datum
29.06.2006 16:08:11
Torge
Kann jemand helfen oder sagen, ob man bei folgenden Code noch ein Datum einfügen kann, ab dem ein Einblenden der Tabellen nur noch mit einem weiteren Passwort funktioniert? Ich weiss nicht, ob dass geht, dass z.B. ab einen gewissen Zeitpunkt nach der Eingabe von USer und Pw nur kurz ein Hinweis kommt Zeit überschritten und ein weiteres Eingabefeld aufgeht und dem ein Zusatz-PW eingegeben werden muss um die Datei auch nach erreiche des Datum nutzen zu können. Vielleicht geht es aber auch anders.
Hoffe habe mich nicht zu kompliziert ausgedrückt.
Vielen Dank schon Mal, hier mein Code bis jetzt:
Private Sub cmdOK_Click()
Dim Date As Integer
Dim Zugang As Boolean
Dim User(3) As String 'Wenn mehr als 2 Benutzer zugelassen werden sollen
Dim Password(3) As String 'her entsprechend höher dimensionieren
Dim i As Long 'und in der For-Schleife der Zugangsprüfung berücksichtigen
Password(1) = "aa" ' Hier Password für Benutzer 1 festlegen
Password(2) = "cc" ' Hier Password für Benutzer 2 festlegen
Password(3) = "ee" ' Hier Password für Benutzer 2 festlegen
User(1) = "bb" 'hier den 1. Benutzernamen festlegen
User(2) = "dd" 'hier den 2. Benutzernamen festlegen
User(3) = "ff" 'hier den 2. Benutzernamen festlegen
'----Zugangsprüfung
Zugang = False
For i = 1 To 3
If Me.txtInput.Text = Password(i) And Me.TextBox1.Value = User(i) Then
Zugang = True
Exit For
End If
Next
Select Case i
Case 1
'hier Code einfügen, der ablaufen soll, wenn User1 sich eingeloggt hat
'Einblenden der Tabellen
Sheets("Messe-Eingabe").Visible = True
Sheets("Messe-Berechnung").Visible = False
Sheets("Kurz-Eingabe").Visible = False
Case 2
'hier Code einfügen, der ablaufen soll, wenn User2 sich eingeloggt hat
'Einblenden der Tabellen
Sheets("Messe-Eingabe").Visible = True
Sheets("Messe-Berechnung").Visible = True
Sheets("Kurz-Eingabe").Visible = False
Case 3
'hier Code einfügen, der ablaufen soll, wenn User2 sich eingeloggt hat
'Tabellen einblenden für alle
Sheets("Messe-Eingabe").Visible = True
Sheets("Messe-Berechnung").Visible = True
Sheets("Kurz-Eingabe").Visible = True
Case Else
End Select
If Zugang Then
'------ab hier ist der Code wieder unverändert----------------
m_blnCancel = False 'Status 'Abbrechen' = False setzen
Me.hide 'UserForm ausblenden
Else
'Wenn ungültiges Passwort
'Inhalt der TextBox löschen und Fokus setzen
MsgBox "Ungültiges oder falsch geschrieben, bitte prüfen!", vbExclamation, Me.Caption
With Me.txtInput
.Text = ""
.SetFocus
End With
End If
End Sub