Zellschutz einzelner Zellen in Excel

L.Faas · 26.02.2007

Hallo ihr da draußen.
Ich habe folgendes Problem:
In einer Tabelle soll eine Eingabe in eine Zelle erfolgen.
Nach der Eingabe soll jweils diese Zelle dann so geschützt sein, dass eine Änderung nicht mehr möglich ist.
Änderungen sollen dann in der Nachbarzelle möglich sein, die aber nach dem Eintrag auch
wieder geschützt wird.
Jetzt noch der Knackpunkt: Das Ganze soll aber durch einen Berechtigten (Admin, Abteilungsleiter usw.)
über Passwort wieder geöffnet werden können und die Zellen sollen dann editierbar sein.
Hat irgendjemand eine Idee wie man sowas (evtl auch über VBA) steuern kann ?

Ich hoffe auf euch und danke euch schon mal
L. Faas
:1

PCDjoe · 28.02.2007

Ola,

welche Excel-Version setzt Ihr denn ein? in 2003 kann man Bereiche für Berechtigte freigeben.

L.Faas · 28.02.2007

Wie nutzen Excel 2000 und XP!
Hast Du da eine Idee ?
Und danke für die schnelle Antwort :1

Matjes · 28.02.2007

Eine kleine Testdatei ist per mail unterwegs.

Gruß Matjes

L.Faas · 01.03.2007

Vielen Dank und wenn ich noch was brauche melde ich mich auf jeden Fall.

Matjes · 01.03.2007

zum Mitlesen:

Die Testdatei enthält 2 Makros: (in DiesesArbeitsblatt)

- Workbook_BeforeSave()
Funktion:
Vor dem Speichern der Datei:
- wird der Blattschutz entfernt , für alle Zellen die Formatierung geschützt gelöscht,
- Alle Zellen mit Inhalt gesucht und als geschützt formatiert, Blattschutz wieder gesetzt.

Für das Setzen/Entfernen des Blattschutztes kann ein Passwort vergeben werden.
Dazu ist die Konsante Private Const pw = anzupassen.

- Workbook_SheetBeforeDoubleClick ()
Funktion:
Bei Doppelklick auf eine geschützte Zelle:
- erscheint: Bitte geben Sie das Paßwort zum entsperren der Zeile ein.,
- Nach Eingabe des richtigen EntsperrPasswortes (AdminPW: xyz) werden die Zellen der Zeile entsperrt.

Das Passwort für den Admin ist in der Konstanten
Private Const cENTSPERRPASSWORT = xyz anzupassen.

Momentan ist es halt xyz

Gruß Matjes

Code:

Option Explicit

 ->&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt; A N P A S S E N >>>>>>>>>>>>>>>>>>>>>>
Private Const cBLTNAME = Tabelle1 -> zu schützendes Blatt
 ->zu Schützender Bereich ab Zeile.../Spalte...
Private Const cZ_ERSTEWERTEZEILE = 3
Private Const cSP_ERSTEWERTESPALTE = 2

Private Const pw =    'hier ggf. PW für Blattschutz eintragen
Private Const cENTSPERRPASSWORT = xyz-> für den Admin
 ->&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt; A N P A S S E N   E N D E >>>>>>>>>>>>

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

  Dim ws As Worksheet
  Dim r As Range, Zelle As Range, ersteAdresse As String
  Dim lRows As Long, lCols As Long

  On Error Resume Next
  Set ws = ThisWorkbook.Worksheets(cBLTNAME)
  Err.Clear: On Error GoTo 0
  If ws Is Nothing Then
    MsgBox Blatt  &amp; cBLTNAME &amp;  nicht vorhanden.
    GoTo AUFRAEUMEN
  End If

 ->Schreibschutz des Blattes entfernen
  ws.Activate
  On Error Resume Next
  ActiveSheet.Unprotect Password:=pw
  If Err.Number &lt;> 0 Then
    MsgBox Blatt-Schutz konnte nicht entfernt werden.
    GoTo AUFRAEUMEN
  End If
  On Error GoTo 0

 ->Bereich der zu schützenden Zellen setzen
  lRows = ws.UsedRange.Rows.Count + ws.UsedRange.Row - 1
  lCols = ws.UsedRange.Columns.Count + ws.UsedRange.Column - 1
  Set r = ws.Range( _
              ws.Cells(cZ_ERSTEWERTEZEILE, cSP_ERSTEWERTESPALTE), _
              ws.Cells(lRows, lCols))

 ->Zellen entsperren
  r.Locked = False

 ->alle nicht leeren Zellen (Werte, nicht Formeln) suchen und sperren
  With r
    Set Zelle = .Cells(1)
    Set Zelle = .Find(What:=*, _
                      After:=Zelle, _
                      LookIn:=xlValues, _
                      LookAt:=xlWhole, _
                      SearchOrder:=xlByRows, _
                      SearchDirection:=xlNext, _
                      MatchCase:=False)
    If Not Zelle Is Nothing Then
      ersteAdresse = Zelle.Address
        Do
          Zelle.Locked = True
          Set Zelle = .FindNext(Zelle)
          If Zelle Is Nothing Then Exit Do
          If Zelle.Address = ersteAdresse Then Exit Do
        Loop
    End If
  End With

 ->Blattschutz setzen
  ActiveSheet.Protect Password:=pw

AUFRAEUMEN:
  Set ws = Nothing: Set r = Nothing: Set Zelle = Nothing
End Sub


Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
  
  Dim sPW As String
  
  If Target.Count = 1 Then
    If Target.Locked Then
      sPW = InputBox( _
            Bitte geben Sie das Paßwort zum entsperren der Zeile ein., _
            Zeile entsperren, )
      If sPW &lt;> cENTSPERRPASSWORT Then
        If sPW &lt;>  Then MsgBox Passwort falsch :-)
        Cancel = True
      Else
       ->Schreibschutz des Blattes entfernen
        On Error Resume Next
        Target.Parent.Unprotect Password:=pw
        If Err.Number &lt;> 0 Then
          MsgBox Blatt-Schutz konnte nicht entfernt werden.
          Cancel = True
          Exit Sub
        End If
        On Error GoTo 0
        Target.EntireRow.Locked = False
        
       ->Blattschutz setzen
        Target.Parent.Protect Password:=pw
      End If
    End If
  End If

End Sub

L.Faas · 06.03.2007

Hallo Matjes,
danke für die Programmierung.
Hat Klasse funktioniert!

Vielen Dank

L.Faas :1

Zellschutz einzelner Zellen in Excel

L.Faas

PCDjoe

L.Faas

Matjes

L.Faas

Matjes

L.Faas

Zellschutz einzelner Zellen in Excel

ANGEBOTE & SPONSOREN

Neueste Themen

Statistik des Forums