Gezielt Zellschutz in Excel durch Bedingung aufheben

Hallo Excelperten :smile:

Ich hab folgendes Problem:

In meiner Excelliste habe ich eine Auflistung der Kollegen. An erster Stelle den von der IT vergebenen Usernamen. Diesen lasse ich beim starten des Workbook mittels VBA auslesen und in einem 2. Sheet in A1 eintragen.

Jetzt habe ich mit einer bedingten Formatierung die Zeile des Kollegen grün eingefärbt.

Was aber eine elegantere Lösung wäre (und sicherere) wenn das Arbeitsblatt komplett geschütz twäre (also nur nicht gesperrte Zellen auswählbar) und nur die Zeile, wo der Username übereinstimmt für den Kollegen auswählbar und beschreibbar wäre.

Ist sowas möglich? Hab echt schon einiges versucht (Zellschutz aufgrund der einfärbung der bedingten Formatierung aufheben, usw) und nix hat geklappt.

Schonmal lieben Dank im Voraus

Liebe Grüße

René

Wenn du schon so weit bist sollte das verständlich sein:

'Blattschutz aufheben
ActiveSheet.Unprotect („test“)
'Sperre aufheben
ActiveSheet.Cells.Locked = True
'Im Beispiel Zeile 12 zum schreiben öffnen
ActiveSheet.Rows(12).Locked = False
'Blatt schützen
ActiveSheet.Protect („test“)

Das musst du halt da einbinden, wo die Auswahl des Users erfolgt. Außerdem natürlichg den Zellbereich, der offen sein soll, anpassen.

fg

Dirk_P

Hallo Dirk.
Danke Dir schonmal dafür. Mein Problem ist damit leider noch nicht ganz gelöst. Die Abfrage welche Zeile betroffen ist klappt leider auch nicht.

Wie ich ja schon sagte ist der ausgelesene Username im 2. Sheet in Zelle A1.
Im 1. Sheet ist dann die Tabelle wo in Spalte A von Zeile 6 bis Zeile 36 Die Usernamen der Kollegen aufgelistet sind.
Leider nicht alphabetisch sortiert und auch mit leerzeilen dazwischen.

Was ich mir vorstelle ist:

  1. Der Username wird ausgelesen - funktioniert
  2. In der Zeile im 1. Sheet wo der Username in der 1. Spalte steht soll den Zellschutz aufgehoben bekommen.
  3. Am Ende soll der Zellschutz wieder auf das komplette Sheet angewandt werden.

Wie gesagt woo es noch hakt bei mir ist die Abfrage welche Zeile entsperrt werden soll.

Schonmal lieben Dank im Voraus

René

Hier den Code den ich mir bisher zusammengebastelt habe:

Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)

Sheets(2).Range("A1").Value = ""
Sheets(1).Unprotect ("egal")
Sheets(1).Cells.Locked = True
Sheets(1).Protect ("egal")

End Sub

Private Sub Workbook_Open()

Dim zei As Integer

Sheets(2).Range("A1").Value = Application.UserName

'nur die benötigte Zeile ungesperrt

zei = 6

Sheets(1).Activate
ActiveSheet.Unprotect („egal“)

Do

If Sheets(1).Cells(zei, 1) = Sheets(2).Cells(1, 1) Then Sheets(1).Rows(zei).Locked = False
    
zei = zei + 1

Loop Until zei = 36

ActiveSheet.Protect („egal“)

End Sub

dim daIstEr as range
dim dasIstDieRow as integer
set daIstEr = activeSheet.range(„A:A“).find(userName, lookat:=xlWhole, LookIn:=xlValues)
if not daIstEr isnothing then
dasIstDieRow = daIstEr.row
else
msgbox(„Gibbet nich“)
end if

Schau dir das mal an. userName ist der Name der gesucht werden soll. „A:A“ ist der Bereich, in dem der Name stehen sollte. dasIstDieRow wäre dann die Zeile, die gefunden wurde.

So aus der Hüfte… Sonst frag noch mal.

fg

Dirk_P

Hallo Dirk,
vielen Dank für den Ansatz, den ich leider nur bedingt nachvollziehen kann. Scheint eine Nummer größer zu sein als ich bisher gearbeitet hab :smile:
Aber wenn ich Deinen Code nutze und die Zeile „if not daIstEr isnothing then“ eingebe bekomme ich die Fehlermeldung dass ein GoTo oder ein Then erwartet wird?

Ist da ein Fehler drin?

Vielen Dank schonmal und Liebe Grüße
René

Da gab es einen Tippfehler. hab das mal in eine Function gepackt, die ich dann auch getestet habe:

Function getRowWithUser(userName As String, lookInSheet As Worksheet) As Integer

Dim daIstDieRow As Range

'Suchen der zeile, in der der Username steht (Annahme: der steht in Spalte A
Set daIstDieRow = lookInSheet.Range("A:A").Find(userName, lookat:=xlWhole, LookIn:=xlValues)

'Wenn der Username gefunden wurde
If Not daIstDieRow Is Nothing Then
    getRowWithUser = daIstDieRow.Row
Else
    'wurde nicht gefunden, dann -1 als Rückgabe als Zeiche: "Fehler!"
    getRowWithUser = -1
End If

End Function

Probiere das mal.

fg

Dirk_P

Hallo Dirk,

ja das mit dem auseinander schreiben von isnothing habe ich auch gefunden - aber habe trotzdem die Fehlermeldung
Laufzeitfehler 424: Objekt erforderlich

Ich hab scheinbar einen Denkfehler.

Ich poste Dir mal meinen Gesamtcode hier. Mal gucken ob Du was siehst:

Private Sub Workbook_Open()

Dim suchsp As Range
Dim uname As Variant
Dim zeil As Integer

'Username auslesen

Sheets(2).Range(„A1“).Value = Application.UserName
uname = Application.UserName

'nur die benötigte Zeile ungesperrt 

Sheets(1).Activate
ActiveSheet.Unprotect („egal“)
ActiveSheet.Cells.Locked = True

Set suchsp = lookInSheet.Range(„A:A“).Find(uname, lookat:=xlWhole, LookIn:=xlValues)

If Not suchsp Is Nothing Then
zeil = suchsp.Row
ActiveSheet.Rows(zeil).Locked = False
Else
'Wenn Username nicht in der Liste soll das ganze Blatt gesperrt/geschützt sein
End If

weiter:
ActiveSheet.Protect („egal“)

ausgang:
End Sub