VBA Zellenüberwachung + Schutz

Hallo,
ich wollte in VBA gerne was kleines Programmieren aber leider weiß ich nicht genau wie, deswegen bitte ich um eure Hilfe!
Also:
Ich will das VBA im Tabellenblatt "test123" die Spalte A C und D überwacht.
Dort wird jeweils ein Datum eingetragen.
Ich will es so haben, dass wenn ein Monat vorbei ist z.b. der Mai dann darf man nur noch 14 Tage nach dem 31.05.2013 noch Sachen für den Mai eintragen. Sobald wir z.b. den 16.06.2013 haben müssen die Zellen geschützt werden und eine Mitteilung ausgegeben werden wie z.b.: "Zellen gespeert, bitte wenden sie sich an Herrn XXX"
Eigentlich könnte man auch sagen das der ganze Bereich von A - AK Überwacht werden muss.
Wenn man z.b. einen Eintrag für den 15.05.2013 am 09.06.2013 ändern will dann muss das gespeert sein und ebenfalls wenn man einen ganz neuen Eintrag für diesen Tag eintragen will.
Man darf dann Werte ändern wenn man das Passwort weiß z.b. "PW123"
Also kurz gesagt:
- Wenn man bestehende Einträge bis 14 Tage danach ändern will dann ist es okay
- Wenn man bestehende Werte nach 14 Tage ändern will im Bereich A - AK dann muss eine Fehlermeldung ausgegeben werden, dabei muss VBA auf Spalte A gucken und dann +14 Tage draufrechnen
- Wenn man einen neuen Eintrag für den Monat zuvor machen will dann geht das ebenfalls nur 14 Tage danach, sonst eine Fehlermeldung
Und man kann diese Fehlermeldung nur mit einem Passwort umgehen!
Ich hoffe auf eure Hilfe!
LG
Dennis

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Dennis-Tim,
Die Überwachung muss bis Zeile 2000 gehen!
bis exakt Zeile 2000, oder egal wie weit? Es ist einfacher, die ganze Spalte zu überprüfen.
- User will Wert in L 2 ändern
- Excel muss checken ob Datum in D 2 im 14 Tage Rahmen liegt
- Falls größer 14 Tage - änderung verhindern - Fehlermeldung : Bitte wenden sie sich an Ihren Administrator
- Der Bereich E 2- AK 2 müsste überwacht werden!
Dazu, kopiere folgende Makros direkt in den Code des Blattes:

Option Explicit
Public oldValue As Variant
Private Sub Worksheet_Change(ByVal Target As Range)
'von Spalte 5-37 überwachen
Const iColMin As Long = 5
Const iColMax As Long = 37
'Prüfdatum in Spalte D
Const iColDate As Long = 4
'Toleranz 14 tage
Const iToleranz As Integer = 14
'Admin-Passwort (im Klartext - aber Excel ist eh nicht sicher)
Const sPass As String = "IchBinAdmin"
Dim bReset As Boolean
bReset = False
If Target.Column >= iColMin And Target.Column

Das begreife ich noch nicht:
- User will neuen Eintrag hinzufügen
- Excel muss checken ob das eingegebene Datum in A&C&D im 14 Tage Rahmen liegt
- Falls Datum länger als 14 Tage zurück liegt - Fehlermeldung
Wo werden denn neue Einträge hinzugefügt? Unter die letzte Zeile? Da stehen noch keine Datums.
Ich sehe auch keine ab E leere Zeile, die als "Neueintrag" in Frage käme.
Sagen wir mal, in A C und D 93 ständen Datums. Hier möchte ich neu Eintragen.
Jetzt solll Excel prüfen ob,
- eines der drei Datums innerhalb der Toleranz liegt oder
- jedes der drei Datums innerhalb der Toleranz liegt?
Nebenbei:
auch ohne "Hack" kann ich ja einfach das Datum in D2 ändern, dann einen Wert nach L2 schreiben, und dann das alte Datum wieder in D2 schreiben. Aber ich nehme an, das wirst du mit Blattschutz lösen.
Grüße,
Klaus M.vdT.

Option Explicit Public oldValue As Variant Private Sub Worksheet_Change(ByVal Target As Range) 'von Spalte 5-37 überwachen Const iColMin As Long = 5 Const iColMax As Long = 37 'Prüfdatum in Spalte D Const iColDate As Long = 4 'Toleranz 14 tage Const iToleranz As Integer = 14 'Admin-Passwort (im Klartext - aber Excel ist eh nicht sicher) Const sPass As String = "IchBinAdmin" 'in diesen Spalten werden neue Datums überprüft Const iColA As Long = 1 Const iColB As Long = 3 Const iColC As Long = 4 Dim bReset As Boolean Dim bAdmin As Boolean bReset = False bAdmin = False If Target.Column >= iColMin And Target.Column

Private Sub Worksheet_Change(ByVal Target As Range) Const strPW As String = "test123" If Not Intersect(Target, Range("A:AK")) Is Nothing Then On Error GoTo ERREXIT Application.EnableEvents = False If Target.Count > 1 Then 'mehrere Zellen ausgewählt Application.Undo Else If Target.Column = 1 Then 'Änderung in A If Target "" Then If Target strPW Then MsgBox "test" Application.Undo End If End If End If Else 'Änderung in B:AK If Cells(Target.Row, 1) = "" Then 'A leer Application.Undo Else If Cells(Target.Row, 1) "" Or _ Cells(Target.Row, 4) "" Then If Application.InputBox("Passwort") strPW Then MsgBox "test" Application.Undo End If End If End If End If End If End If ERREXIT: Application.EnableEvents = True End Sub

Private Sub Worksheet_Change(ByVal Target As Range) Const strPW As String = "test123" If Not Intersect(Target, Range("A:AK")) Is Nothing Then On Error GoTo ERREXIT Application.EnableEvents = False If Target.Count > 1 Then If Target.Count = Columns.Count Then 'ganze Zeile If Application.InputBox("Passwort") strPW Then MsgBox "test" Application.Undo End If Else 'mehrere Zellen ausgewählt Application.Undo End If Else If Target.Column = 1 Then 'Änderung in A If Target "" Then If Target strPW Then MsgBox "test" Application.Undo End If End If End If Else 'Änderung in B:AK If Cells(Target.Row, 1) = "" Then 'A leer Application.Undo Else If Cells(Target.Row, 1) "" Or _ Cells(Target.Row, 4) "" Then If Application.InputBox("Passwort") strPW Then MsgBox "test" Application.Undo End If End If End If End If End If End If ERREXIT: Application.EnableEvents = True End Sub

Beliebteste Forumthreads (12 Monate)

25
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

VBA Zellenüberwachung + Schutz

25 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

25
Beiträge zum Forumthread

Beiträge zu diesem Forumthread