Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender

Forumthread: Zellen nach Datum schützen

Zellen nach Datum schützen
Nepomuk112
Hallo zusammen.
Habe 12 Tabellenblätter, für jeden Monat eins.
In jedem Tabellenblatt sind die Tage von 1-31 oder halt weniger.
Ausserdem sind noch ein paar Spalten für berechnungen da, die sowie so schon geschützt sind.
Jetzt sollen die einzelnen Tagesspalten nach einen Tag nach erreichen dieses Datums gesperrt werden, so dass niemand mehr darauf zugreifen kann.
Besser wäre noch, wenn man dann diese Zellen nur noch über ein Passwort zum ändern freigeben könnte.
Also ich sag mal so. Im Tabellenblatt für Januar wird die Spalte für den 1. am 2. gegen überschreiben gesperrt.
Sollte sie nun doch noch einmal geändert werden dann nur mittels Passwort oder durch herausnehmen der VBA programmierung.
Ich hoffe Ihr versteht was ich meine.
LG Nepomuk
Anzeige

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Zellen nach Datum schützen
06.06.2010 11:28:41
hary
Hallo
eine Moeglichkeit. hier ohne Passwort
in den Code der Arbeitsmappe.

Option Explicit
Private Sub Workbook_Open()
Dim rng As Range
Dim wks As Worksheet
Application.ScreenUpdating = False
For Each wks In ActiveWorkbook.Worksheets
wks.Unprotect 'ggf Passwort
For Each rng In wks.Range("A1:A31") 'Bereich anpassen
If IsDate(rng.Value) Then
If CDate(rng.Value) 

gruss hary
Anzeige
AW: Zellen nach Datum schützen
06.06.2010 11:29:34
Oberschlumpf
Hi #Name?
Klick im VBA-Editor im Projekt-Explorer doppelt auf "DieseArbeitsmappe" und füge diesen Code in das Fenster ein, über dem 2 Comboboxen sichtbar sind:
Private Sub Workbook_Open()
Dim liRow As Integer, liShCount As Integer
For liShCount = 1 To ThisWorkbook.Sheets.Count
With Sheets(liShCount)
.Unprotect "test"
.Range("A1" & ":A" & .Cells(Rows.Count, 1).End(xlUp).Row).Locked = False
For liRow = 1 To .Cells(Rows.Count, 1).End(xlUp).Row
If .Range("A" & liRow).Value 
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel  _
As Boolean)
If Target.Column = 1 And Target.Locked = True Then
If InputBox("Geben Sie das Passwort zum Ändern geschützter Zellen ein:", "Passwort  _
erforderlich") = "test" Then
ActiveSheet.Unprotect "test"
Target.Locked = False
End If
End If
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Column = 1 And Target.Locked = False Then
Target.Locked = True
ActiveSheet.Protect "test"
End If
End Sub

Erklärung:
Workbook_Open
Jedes Mal,wenn jemand die Datei öffnet, wird in jedem Tabellenblatt (du hast ja nur 12, wie du schreibst) die Spalte A mit den Datumseinträgen geprüft.
Wenn das darin stehende Datum kleiner ist als das aktuelle Datum, wird die Zelle für weitere Eingaben gesperrt. Jedes Tabellenblatt erhält einen Blattschutz mit dem Passwort test.
SheetBeforeDoubleClick
Die Sperre einer Zelle mit altem Datum lässt sich nur deaktivieren, wenn du in diese Zelle doppelt klickst.
Einfach nur den Wert überschreiben, funktioniert nicht, da das Blatt ja geschützt ist.
Also:
- Doppelklick in gewünschte Zelle in Spalte A
- es erscheint eine Inputbox, die die Eingabe eines Passwortes verlangt. Passwort = test
- danach wird die Zelle freigegeben und du kannst den alten Wert überschreiben.
SheetChange
- nach Verlassen der Zelle (egal ob Wert geändert oder nicht) wird die Zelle wieder gesperrt
ganz wichtig!!!
Du musst in jedem Tabellenblatt jede Zelle, die immer veränderbar sein soll, über Format/Zellen/Schutz die Option "Gesperrt" deaktivieren!!
Wenn du das nicht tust, kannst du bei aktiviertem Blattschutz keine gesperrte Zelle mehr verändern.
Und die oben beschriebene Option ist standardmäßig immer aktiviert.
Und natürlich solltest du auch den Zugriff auf den VBA-Code mit Passwort schützen.
Überall in diesem Code wird das Passwort test verwendet.
Das kannst/solltest du naürlich ändern.
Hilfts denn?
Ciao
Thorsten
Anzeige
etwas kürzer..
06.06.2010 11:45:49
Steffen
Hallo,
mal zum Testen ,der Code steht im Modul der Arbeitsmappe und wirkt somit über alle Arbeitsblätter.
https://www.herber.de/bbs/user/69918.xls
Grüße
Steffen
AW: Zellen nach Datum schützen
06.06.2010 11:51:06
Tino
Hallo,
hier meine Version.
kommt als Code in DieseArbeitsmappe
Option Explicit 
 
Private Sub Workbook_Open() 
Dim ErstesDatum As Date, LetztesDatum As Date 
Dim NCount As Long, varMinRow, varMaxRow 
 
Const strPass$ = "nepomuk112" 'Kennwort für Tabelle anpassen 
 
For NCount = 1 To 12 'Tabelle 1 bis 12 
    If NCount > Month(Date) Then Exit For 
    With Sheets(NCount) 
        If NCount < Month(Date) Then 
            LetztesDatum = DateSerial(Year(Date), NCount + 1, 0) 
        Else 
            LetztesDatum = DateSerial(Year(Date), NCount, Day(Date) - 1) 
        End If 
 
        varMinRow = Application.Match(CLng(ErstesDatum), .Columns(1), 0) 
        varMaxRow = Application.Match(CLng(LetztesDatum), .Columns(1), 0) 
         
        If IsNumeric(varMinRow) And IsNumeric(varMaxRow) Then 
            .Protect Password:=strPass, UserinterfaceOnly:=True 
            .Range(.Rows(varMinRow), .Rows(varMaxRow)).EntireRow.Locked = True 
        End If 
    End With 
Next NCount 
 
End Sub 
 
Zum aufheben, muss ein extra Code erstellt werden.
Gruß Tino
Anzeige
@Tino
06.06.2010 11:54:32
Oberschlumpf
Moin Moin
Verrätst du mir bitte mal, mit welchem Tool du diese doch viel schönere Codedarstellung hinbekommst?
Danke!
Ciao
Thorsten
aber nur weil Du es bist ;-)
06.06.2010 12:42:06
Tino
Hallo,
ich verwende
VBA zu HTML
http://vbahtml.origo.ethz.ch/download
Gruß Tino
Anzeige
grins..viel viel DANKE! ;-) owT
06.06.2010 12:51:54
Oberschlumpf
hier noch meine Testmappe ...
06.06.2010 12:45:42
Tino
Hallo,
mit Code zum aufheben beim activieren der Tabelle.
https://www.herber.de/bbs/user/69919.xls
Die habe ich nicht ausgiebig getestet, nur mal so durchprobiert. Passwort = nepomuk112
Gruß Tino
;

Forumthreads zu verwandten Themen

Anzeige
Anzeige
Entdecke relevante Threads

Schau dir verwandte Threads basierend auf dem aktuellen Thema an

Alle relevanten Threads mit Inhaltsvorschau entdecken
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige