[VBA] Abfrage über Anmeldenamen ohne Funktion
09.04.2019 11:12:09
grmmphn
mein Ziel mit diesem Makro ist, dass die Zugangsberechtigung zu den letzten Arbeitsblättern mit Hilfe des Windows-Anmeldenames reguliert wird. Dazu habe ich eine externe Arbeitsmappe erstellt, die in Spalte A eine Auflistung der berechtigten Benutzer enthält und mit dem Windows-Anmeldenamen verglichen wird.
So soll sichergestellt werden, dass man jederzeit Benutzer hinzufügen und entfernen kann, ohne die "Haupt-Arbeitsmappe" zu verändern.
Nun habe ich allerdings das Problem, dass ich zwar Daten aus meiner externen Arbeitsmappe auslesen kann, das habe ich mit einer simplen Zellenkopie überprüft, jedoch scheint der Abgleich zwischen dem Anmeldenamen des Benutzers und der Benutzerliste, in der externen Arbeitsmappe, nicht zu funktionieren. Die Haupt-Arbeitsmappe sperrt nun generell die letzten Arbeitsblätter, beginnend mit dem zweiten Blatt.
Zur Vereinfachung habe ich mich nur auf meinen Benutzernamen in der Benutzerliste bezogen, der sich in Zelle 2A befindet.
Private Sub Workbook_Open()
Dim ValidUser As String
Dim i As Long
Dim wbAdmins As Workbook
Dim ws As Worksheet
Application.ScreenUpdating = False
' Aufruf der externen Benutzerliste
Set wbAdmins = Workbooks.Open(Filename:="C:\*\Admins_Excel.xlsm")
Set ws = wbAdmins.Worksheets(1)
ValidUser = ws.Cells(2, "A")
If Not IsError(Application.Match(Environ("Username"), ValidUser, 0)) Then
For i = 1 To ThisWorkbook.Worksheets.Count
Worksheets(i).Visible = True
Next
Else
For i = 2 To ThisWorkbook.Worksheets.Count
Worksheets(i).Visible = xlVeryHidden
Next
End If
Application.DisplayAlerts = False
wbAdmins.Close
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub