Zugriffsrechte nach Anwender unterscheiden

Hallo liebe Excellenzen !
Mit dem nachfolgenden Code frage ich den Excel-Anwender ab, der eine Exceldatei zu öffnen versucht und erlaube oder verweigere den Zugriff auf die Datei.
Meine Frage : Kann dieser Code so geändert werden, daß die im Makro hinterlegten Anwender Schreibe- und Leseberechtigung haben, alle anderen Anwender aber nur die Leseberechtigung ohne Möglichkeit, etwas zu ändern ?

Private Sub Workbook_Open()
'Abfrage des Excel-Anwenders, der die Datei öffnet
'Wenn der Anwendername gleich/ungleich des hinterlegten Namens ist, soll ein Makro starten
Dim strUser As String
strUser = Application.UserName
If strUser = ("Meier, Fritz") Or strUser = ("Müller, Jonas") Then '  oder = verwenden
'Makro starten:
MsgBox "Willkommen"
Exit Sub
Else
'Falls Datei von einem anderen Anwender geöffnet wird :
MsgBox "Du kummst hier net rein !" & vbCrLf & "Die Datei wird geschlossen"
ThisWorkbook.Close
End If
End Sub

Für sachdienliche Hinweise, ob und wie sowas gehen könnte, bedanke ich mich im voraus.
Liebe Grüße
Wolfgang

Hi
das sollst du ja auch nicht selbst machen, sondern per Makro.
Tipp:
Ich würde aber NICHT den Application.UserName (den kann der Benutzer in Excel umstellen) nehmen sondern Environ("Username") 'der Anmeldename am System.
Microsoft Excel Objekt DieseArbeitsmappe

Option Explicit 
 
Private Sub Workbook_BeforeClose(Cancel As Boolean) 
    Dim TB 
    With ThisWorkbook 
        For Each TB In .Sheets 
            TB.Protect Password:="ABC" 
        Next 
        .Save 
    End With 
End Sub 
 
Private Sub Workbook_Open() 
    'Abfrage des Excel-Anwenders, der die Datei öffnet 
    'Wenn der Anwendername gleich/ungleich des hinterlegten Namens ist, soll ein Makro starten 
    Dim strUser As String, TB 
    strUser = Application.UserName 
    'strUser = Environ("Username") 'der Anmeldename am System 
    Stop 
    If strUser = ("Meier, Fritz") Or strUser = ("Müller, Jonas") Then ' <> oder = verwenden 
    'Makro starten: 
    MsgBox "Willkommen" 
    With ThisWorkbook 
        For Each TB In .Sheets 
            TB.Unprotect Password:="ABC" 
        Next 
         
    End With 
    Exit Sub 
    Else 
    'Falls Datei von einem anderen Anwender geöffnet wird : 
     MsgBox "Du kummst hier net rein !" & vbCrLf & "Die Datei wird geschlossen" 
     ThisWorkbook.Close False 
    End If 
End Sub

LG UweD

Zugriffsrechte nach Anwender unterscheiden

Forumthread: Zugriffsrechte nach Anwender unterscheiden

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Infobox / Tutorial