Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1684to1688
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Zellen je nach Benutzer freigeben

Zellen je nach Benutzer freigeben
17.04.2019 10:51:48
Lutz
Hallo,
ich möchte ja nach Benutzer verschiedene Zellen in z.B. 10gleichen Tabellenblättern freigeben. _
So sieht mein Code für das 1.TB aus:
Sub zellen_freigeben()
' alle Zellen schützen '
Sheets("01").Cells.Locked = True
' wenn kennwort1 dann diese zellen freigeben '
Sheets("01").Range("C4:E4,H4,C6:H6,C8,C10,C14:G14,C17:G17,C20:G21,C23:G23,C26:G26,C31:G35,   _
_
_
_
_
_
C37:G40").Locked = False
' wenn kennwort2 dann diese zellen freigeben '
Sheets("01").Range("K14:O14,K17:O17,K20:O21,K23:O23,K26:O26,K31:O35,K37:O40").Locked =  _
False
Sheets("01").Range("S14:W14,S17:W17,S20:W21,S23:W23,S26:W26,S31:W35,S37:W40").Locked =  _
False
Sheets("01").Range("AA14:AE14,AA17:AE17,AA20:AE21,AA23:AE23,AA26:AE26,AA31:AE35,AA37:AE40"). _
_
_
_
_
_
Locked = False
Sheets("01").Range("C43:G43,C45:E45,C47:H47,C49:E49,C51:E51,C53:H53,C55:E55,C57:E57,C59:E59, _
_
_
_
_
_
C61:E61").Locked = False
End Sub

Wie kann ich das schlanker gestalten, das ich das jetzt nicht für die nächsten 9TBs drunterkopieren und anppassen muss?

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Zellen je nach Benutzer freigeben
17.04.2019 11:54:15
Werner
Hallo Lutz,
dir ist schon klar, dass du im Code dann am Anfang den Blattschutz aufheben und am Ende wieder setzen mußt, damit das auch Wirkung zeigt?
Und dann stellt sich noch die Frage, ob sich das tatsächlich auch auf alle Blätter auswirken soll, die in deiner Datei vorhanden sind oder ob einzelne Blätter ausgenommen werden sollen?
Sub zellen_freigeben()
Dim ws As Worksheet, strPasswort As String
strPasswort = InputBox("Passwort eingeben:", "Passworteingabe")
If Not strPasswort = vbNullString Then
For Each ws In ThisWorkbook.Worksheets
ws.Unprotect "DeinPasswort"
ws.Cells.Locked = True
Select Case strPasswort
Case "Passwort1"
ws.Range("C4:E4,H4,C6:H6,C8,C10,C14:G14,C17:G17,C20:G21," _
& "C23:G23,C26:G26,C31:G35,C37: G40 ").Locked = False
Case "Passwort2"
ws.Range("K14:O14,K17:O17,K20:O21,K23:O23,K26:O26,K31:O35," _
& "K37:O40").Locked = False
ws.Range("S14:W14,S17:W17,S20:W21,S23:W23,S26:W26,S31:W35," _
& "S37:W40").Locked = False
ws.Range("AA14:AE14,AA17:AE17,AA20:AE21,AA23:AE23,AA26:AE26,AA31:AE35," _
& "AA37:AE40").Locked = False
ws.Range("C43:G43,C45:E45,C47:H47,C49:E49,C51:E51,C53:H53,C55:E55,C57:E57," _
& "C59:E59, C61: E61 ").Locked = False
Case Else
MsgBox "Sorry Passwort ist falsch."
End Select
ws.Protect "DeinPasswort"
Next ws
End If
End Sub
Gruß Werner
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige