Userbezogener Schreibschutz und vorauswahl und so

Hallo super Forum und Excel sowie VBA Freaks und Könner,
Habe folgendes vor:
Userbezogener Schreibschutz und so weiter.
1. Jeder User darf nur "seine" Zellen (z.B. Elfriede A3-D3 und A15-B15) beschreiben.
2. Elfriede darf die Zellen von allen bearbeiten (sie ist Teamleiter), aber nicht die ganze Tabelle (das kann ich sicherlich über gesperrte Zellen einstellen)
Der Teamleiter steht immer an erster Stelle (hier A3).
3. Userbezogen sollen die zu bearbeitenden Zellen farbig dargestellt werden.
4. Der User der gerde mit der Tabelle auf seinem Rechner arbeitet soll hinter der Zelle seines Namens (hier spalte B3) ein X bekommen .Vorher muss der
Bereich (hier B3-B7 gereinigt werden)
5. Die Usernamenabfrage darf nicht zwischen Groß- und Kleinschrift unterscheiden.
6 Der Username darf nicht als Namen in VBA stehen, sonder muss aus der Tabelle geholt werden (hier: A3-A6)
Ich hoffe mal das es da auch eine Lösung für gibt und
verneige mich vor Euch und bedanke mich schon einmal.
lg Wolle
https://www.herber.de/bbs/user/60899.xls

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Wolle,
hier mal ein Vorschlag.
Sobald das Makro eingerichtet ist, werden beim Schließen der Datei alle Zellen in Tabelle1 gesperrt.
Den Code muss du im VBA-Editor unter dem Modul "DieseArbeitsmappe" einfügen.
Beim Öffnen der datei wird der Username (Anmeldename im Netz) geprüft und die entsprechenden Zellen gefärbt und entsperrt.
Das Makro arbeitet mit dem einfachen Blattschutz ohne Kennwort.
Gruß
Franz


Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Alle Zellen sperren
Dim wks As Worksheet
Set wks = Worksheets("Tabelle1")
With wks
.Unprotect
'Alle Zellen sperren
.Cells.Locked = True
.Protect
End With
Me.Save
End Sub
Private Sub Workbook_Open()
'Userbereich entsperren und markieren
Dim wks As Worksheet
Dim strUser As String, strTeamleiter As String
Dim rngUserA As Range, rngUserB As Range, Zelle As Range
Set wks = Worksheets("Tabelle1")
strUser = LCase(VBA.Environ("Username"))
'strUser = LCase("Elfriede") 'Testzeile
With wks
'Teamleiter merken
strTeamleiter = LCase(.Range("A3").Value)
.Unprotect
'Alle Zellen sperren
.Cells.Locked = True
'oberen Bereich (A3 bis max. zur nächsten Leerzeile nach unten) markieren, aufbereiten
Set rngUserA = .Range(.Cells(3, 1), .Cells(3, 1).End(xlDown))
'Farben zurücksetzen
.Range(rngUserA, rngUserA.Offset(0, 3)).Interior.ColorIndex = xlColorIndexNone
'"X" löschen
rngUserA.Offset(0, 1).ClearContents
For Each Zelle In rngUserA
If strUser = strTeamleiter Then
.Range(Zelle.Offset(0, 1), Zelle.Offset(0, 3)).Locked = False
End If
If LCase(Zelle.Value) = strUser Then
.Range(Zelle.Offset(0, 1), Zelle.Offset(0, 3)).Locked = False
.Range(Zelle, Zelle.Offset(0, 3)).Interior.ColorIndex = 4 'hellgrün
Zelle.Offset(0, 1) = "X"
End If
Next
'unteren bereich (A15 bis zur letzten Zeile mit daten in Spalte A) markieren, aufbereiten
Set rngUserB = .Range(.Cells(15, 1), .Cells(.Rows.Count, 1).End(xlUp))
.Range(rngUserB, rngUserB.Offset(0, 1)).Interior.ColorIndex = xlColorIndexNone
For Each Zelle In rngUserB
If strUser = strTeamleiter Then
.Range(Zelle.Offset(0, 1), Zelle.Offset(0, 1)).Locked = False
End If
If LCase(Zelle.Value) = strUser Then
.Range(Zelle.Offset(0, 1), Zelle.Offset(0, 1)).Locked = False
.Range(Zelle, Zelle.Offset(0, 1)).Interior.ColorIndex = 4 'hellgrün
End If
Next
.Protect
End With
End Sub

Beliebteste Forumthreads (12 Monate)

Userbezogener Schreibschutz und vorauswahl und so

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Userbezogener Schreibschutz und vorauswahl und so

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread