Makro: Zugriffsberechtigung per Windows-Anmeldename

Guten Tag zusammen,
meine VBA-Kenntnisse beschränken sich darauf, dass ich Codes suche und meistens per kopieren/einfügen zum Laufen bringe.
Mein neues "Projekt" ist allerdings ein paar Nummern zu hoch für mich.
Es wäre klasse, wenn mir jemand helfen könnte.
Ich möchte, dass in unseren Personalplan nur bestimmte Personen Zugriff auf den kompletten Plan haben.
Anderen Benutzer sollen aus Datenschutzgründen nur Zugriff auf die laufende Woche plus die 2 Folgewochen haben.
Die Mappe ist so aufgebaut, dass jedes Arbeitsblatt eine Kalenderwoche abbildet.
Frage: Ist es möglich, dass ein Makro zuerst den Windowsanmeldename mit einer Liste abgleicht. Auf dieser Liste sollen die Namen stehen, die alles einsehen dürfen bzw. eben nur eingeschränkten Zugriff auf die Mappe haben.
voller Zugriff: können die komplette Mappe einsehen und bearbeiten
eingeschränkter Zugriff: können nur die 3 Wochen einsehen und diese bearbeiten
Ich habe mal eine Beispiel-Mappe angehängt.
https://www.herber.de/bbs/user/134238.xlsm
Vielen Dank im Voraus für eure Bemühungen.
Gruß
RaMa

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Workbook_Open() Dim str_benutzer As String Dim rng_benutzer As Range Dim lng_zeile As Long Dim obj_wks As Worksheet Dim obj_wks_berechtigungen As Worksheet Dim bol_vollzugriff As Boolean Dim lng_kw As Long str_benutzer = Environ("Username") Set obj_wks_berechtigungen = ThisWorkbook.Worksheets("Berechtigungen") lng_kw = KWoche(Date) Set rng_benutzer = obj_wks_berechtigungen.Range("A:A").Find(str_benutzer) If rng_benutzer Is Nothing Then MsgBox "Benutzer nicht gefunden" ThisWorkbook.Close Exit Sub Else lng_zeile = rng_benutzer.Row If obj_wks_berechtigungen.Cells(lng_zeile, 2) = "voll" Then bol_vollzugriff = True Else bol_vollzugriff = False End If End If For Each obj_wks In ThisWorkbook.Worksheets If bol_vollzugriff = True Then obj_wks.Visible = xlSheetVisible Else If obj_wks.Name "Berechtigungen" Then If CLng(Right(obj_wks.Name, 2)) >= lng_kw And CLng(Right(obj_wks.Name, 2))

Private Sub Workbook_BeforeClose(Cancel As Boolean) Dim obj_wks As Worksheet For Each obj_wks In ThisWorkbook.Worksheets If obj_wks.Name "Berechtigungen" Then If CLng(Right(obj_wks.Name, 2)) >= lng_kw And CLng(Right(obj_wks.Name, 2))

Private Sub Workbook_BeforeClose(Cancel As Boolean) Dim obj_wks As Worksheet Dim lng_kw As Long For Each obj_wks In ThisWorkbook.Worksheets lng_kw = KWoche(Date) If obj_wks.Name "Berechtigungen" Then If CLng(Right(obj_wks.Name, 2)) >= lng_kw And CLng(Right(obj_wks.Name, 2))

Hallo Regina,
nochmals danke für deine Zeit.
Allerletzte "blöde" Frage.
Ich habe in "Diese Arbeitsmappe" jetzt alle Befehle untereinander kopiert, stimmt das jetzt so (wird nur etwas seltsam angezeigt, alle Befehle sind untereinander)?

Private Sub Workbook_Open()
Dim str_benutzer As String
Dim rng_benutzer As Range
Dim lng_zeile As Long
Dim obj_wks As Worksheet
Dim obj_wks_berechtigungen As Worksheet
Dim bol_vollzugriff As Boolean
Dim lng_kw As Long
str_benutzer = Environ("Username")
Set obj_wks_berechtigungen = ThisWorkbook.Worksheets("Berechtigungen")
lng_kw = KWoche(Date)
Set rng_benutzer = obj_wks_berechtigungen.Range("A:A").Find(str_benutzer)
If rng_benutzer Is Nothing Then
MsgBox "Benutzer nicht gefunden"
ThisWorkbook.Close
Exit Sub
Else
lng_zeile = rng_benutzer.Row
If obj_wks_berechtigungen.Cells(lng_zeile, 2) = "voll" Then
bol_vollzugriff = True
Else
bol_vollzugriff = False
End If
End If
For Each obj_wks In ThisWorkbook.Worksheets
If bol_vollzugriff = True Then
obj_wks.Visible = xlSheetVisible
Else
If obj_wks.Name  "Berechtigungen" Then
If CLng(Right(obj_wks.Name, 2)) >= lng_kw And CLng(Right(obj_wks.Name, 2))

Function KWoche(ByVal Datum As Date) As Long
Dim t As Long
t = DateSerial(Year(Datum + (8 - Weekday(Datum)) Mod 7 - 3), 1, 1)
KWoche = ((Datum - t - 3 + (Weekday(t) + 1) Mod 7)) \ 7 + 1
End Function
Sub Berechtigungen_zeigen()
Worksheets("Berechtigungen").Visible = True
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim obj_wks As Worksheet
For Each obj_wks In ThisWorkbook.Worksheets
If obj_wks.Name  "Berechtigungen" Then
If CLng(Right(obj_wks.Name, 2)) >= lng_kw And CLng(Right(obj_wks.Name, 2))

Grüße
Raphael

Beliebteste Forumthreads (12 Monate)

Makro: Zugriffsberechtigung per Windows-Anmeldename

20 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

20
Beiträge zum Forumthread

Beiträge zu diesem Forumthread