Benutzerprofile in Userform generieren

[Kaywarri124]

Guten Tag Excelianer,

Und wieder mal geh ich den leichten Weg, da ich nur quatsch im Internet finde.

Ich öffne über einen CommandButton in einer UF1 eine neue UF2. Dies wird durch eine InputBox und einer Passwort Eingabe erschwert.

Das Passwort gebe ich im Modul hier ein:

Sub Auswahl_100_öffnen()
   
Dim str As String
str = InputBox("Schreiben darf nur Befugtes Personal. Passwort erfoderlich")
 If str = "" Then Exit Sub Else
 If str = "123" Or str = "456" Then
 
 '  123 Mustermann
 '  456 Musterfrau
   
    UF_Auswahl_100.Show
   
 Else
 MsgBox "Passwort stimmt nicht überein!"
 End If
 
End Sub


Frage:

1. Wäre es möglich zu bestimmen, durch z.B. eine Personalnummer, wer auf die UF2 zugreifen kann.
2. Der von mir ernannte Nutzer kann sein eigenes PW erstellen und das wird dann gespeichert für das nächste mal. Am besten ist es wohl wenn das PW in einer versteckten Tab2 gespeichert wird.
3. Es geht natürlich auch über eine UF  mit TxtBoxen Benutzername: "Personalnummer" Passwort: "eigenes Passwort" wenn es stimmt dann mit CommandButton1 weiter zur gesperrten UF2.

möglich ja / nein ?

Wenn nicht dann muss die Eingabe mit Hand gemacht werden.


Danke danke danke :)

[Rabe]

Hi,

jeder Benutzer hat ja einen Windows-Account mit Benutzername und Passwort.

Ich regele die Zugriffsberechtigungen für Dateien und einelne Arbeitsblätter immer über diesen Account, dann muß kein weiteres Passwort verwaltet und eingegeben werden.

So ungefähr:

Option Explicit

Private Sub Workbook_Open()
   Dim s As String
   
   s = VBA.Environ("Username")                        'auslesen des Windows Benutzernamens 
   
   'Datei generell schreibgeschützt öffnen 
   'Ausdruck.Open(FileName, UpdateLinks, ReadOnly, Format, Password, WriteResPassword, IgnoreReadOnlyRecommended, Origin, Delimiter, Editable, Notify, Converter, AddToMru, Local, CorruptLoad) 
'   If Environ("username") <> "User1" Then 
'      Application.DisplayAlerts = False 
'      Workbooks.Open ThisWorkbook.FullName, , True         'schreibgeschützt, nur ein User (ich) darf alles bearbeiten 
'   End If 
   
   With ThisWorkbook
      Select Case s                                   'Tabellen, Bereiche und Formularschaltflächen ausblenden, je nach Account 
      Case Is = "User1", "User2":
         For i = 1 To Sheets.Count
            .Sheets(i).Visible = True
            .Sheets(i).Unprotect 'Password:="test"    'alle Blätter Blattschutz entfernen; falls erforderlich, mit Psswort 
         Next i
         .Sheets("Tabelle2").Visible = True
         '.Range("1:46").EntireRow.Hidden = False     'Zeilen einblenden 
         '.Range("48:60").EntireRow.Hidden = True     'Zeilen ausblenden 
         '.Sheets("Übersicht").DrawingObjects("Button 1").Visible = True      'auf Übersicht Button1 einblenden 
         .Sheets("Tabelle2").Range("K1:K3") = ""      'Zellen leeren 

      Case Is = "User4", "User5", "User6":
         For i = 1 To Sheets.Count
            .Sheets(i).Visible = True                 'alle Blätter sichtbar 
         Next i
         .Sheets("Tabelle2").Visible = True           'Blatt "Tabelle2" sichtbar 
      Case Is = "User3":
         For i = 1 To Sheets.Count
            .Sheets(i).Visible = True                 'alle Blätter sichtbar 
            .Sheets(i).Protect 'Password:="Test"      'Blattschutz evtl. mit Passwort 
         Next i
         .Sheets("Tabelle2").Visible = False          'Blatt "Tabelle2" ausblenden 
      Case Is = "User7", "User8", "User9", "User10":
         For i = 1 To Sheets.Count
            .Sheets(i).Visible = True                 'alle Blätter sichtbar 
         Next i
         .Sheets("Tabelle2").Visible = False          'Blatt "Tabelle2" ausblenden 
      Case Else                                       'alle anderen User 
         'Datei schreibgeschützt öffnen 
         'Ausdruck.Open(FileName, UpdateLinks, ReadOnly, Format, Password, WriteResPassword, IgnoreReadOnlyRecommended, Origin, Delimiter, Editable, Notify, Converter, AddToMru, Local, CorruptLoad) 
         Application.DisplayAlerts = False            'ausschalten der Anzeige von Meldungen 
         Workbooks.Open ThisWorkbook.FullName, , True
         Call drei_Blätter_zeigen                     'nur drei definierte Blätter anzeigen 
         .Sheets("Tabelle3").Activate                 'Blatt "Tabelle3" aktivieren 
         '.Sheets("Tabelle3").Visible = True           'Blatt "Tabelle3" sichtbar 
         ' 
         'For i = 1 To Sheets.Count 
         '   If .Sheets(i).Name <> "Tabelle2" Then 
         '     .Sheets(i).Visible = False              'alle Blätter ausblenden, außer Tabelle2 
         '   End If 
         'Next i 
      End Select
   End With
   Application.DisplayAlerts = True                   'einschalten der Anzeige von Meldungen 
   
End Sub