Blattschutz AB Verfallsdatum

Computer: Software & Programmierung Office Software
1

Wie würdet Ihr einen Blattschutz ab Verfallsdatum einrichten? Gibt es da Standardfunktionen oder geht das nur mit VBA?

2

Hallo Peter,
das geht wohl nur mit VBA.

Wo sollte denn das Verfallsdatum stehen? Wenn man das weiss, kann man eine Eregnisprozedur schreiben, die z. B. bei Blattaktivierung das Datum prüft und dann nach Verfall das Blatt schützt. Man könnte das ganze auch beim Open-Ereignis der Mappe (evtl. für mehrere Blätter) machen.

Grüße (kann nicht schaden)
Erich

3

Wie würdet Ihr einen Blattschutz ab Verfallsdatum einrichten?
Gibt es da Standardfunktionen oder geht das nur mit VBA?

in diese Arbeitsmappe

Private Sub Workbook_Open()
Dim wks As Worksheet
Dim verfall As Date
verfall = „dein Datum einsetzen“
For Each wks In Worksheets
If Date

4

Spitzenmäßig - so eine ausführliche Antwort. Da ich leider VBA-neuling bin, brauche ich offensichtlich noch eine Info:

Ich habe Deinen Code in EIN Modul kopiert, ein Datum eingesetzt und ausgeführt => KEINE Fehlermeldung. Aber leider auch KEIN ERfolg. Ich kann in alle Tabellenblätter schreiben. Nachstehend mein adaptierter Code zur Prüfung:

Private Sub Workbook_Open()
Dim wks As Worksheet
Dim verfall As Date
verfall = „12.05.2005“
For Each wks In Worksheets
If Date [Bei dieser Antwort wurde das Vollzitat nachträglich automatisiert entfernt]

5

Hallo Peter,

den Code von Spaguzzi muß du im VBA-Editor nach Doppelklick auf „Diese Arbeitsmappe“ einfügen.

Folgende Zeile kann danach noch Ärger bereiten, da EXCEL bei Verarbeitung von Datumsangaben in VBA etwas eigen ist:

verfall = „12.05.2005“

Fall es Probleme gibt, dann ändern in

verfall = cdate(„12.05.2005“)

Fall du nur einzelne Tabelle schützen möchtest, dann mein Vorschlag. Das Verfalldatum wird dann in Zelle „B1“ (kannst du natürlich anpassen) eingetragen. Den Code kopierst du im VBA-Editor dann in den Abschnitt der entsprechenden Tabelle.

Private Sub Worksheet\_Activate()
 Dim Verfalldatum As Date
 Verfalldatum = Application.Range("B1").Value
 If Date \>= Verfalldatum Then
 ActiveSheet.Protect Password:="Passwort", DrawingObjects:=True, Contents:=True, Scenarios:=True
 MsgBox ("Tabelle ist geschützt")
 End If
End Sub

Private Sub Worksheet\_SelectionChange(ByVal Target As Excel.Range)
 If Target.Address = "$B$1" Then
 If InputBox("Kennwort?", "Zellwert ändern", "\*\*\*") "Passwort" Then GoTo NaechsteZelle
 ActiveSheet.Unprotect Password:="Passwort"
 Target.Value = CDate(InputBox("Verfalldatum?", "Zellwert ändern", Format(Target.Value, "DD.MM.YYYY")))
NaechsteZelle:
 ActiveCell.Offset(1, 0).Select
 End If
End Sub

Gruß
Franz

Spitzenmäßig - so eine ausführliche Antwort. Da ich leider
VBA-neuling bin, brauche ich offensichtlich noch eine Info:

Ich habe Deinen Code in EIN Modul kopiert, ein Datum
eingesetzt und ausgeführt => KEINE Fehlermeldung. Aber
leider auch KEIN ERfolg. Ich kann in alle Tabellenblätter
schreiben. Nachstehend mein adaptierter Code zur Prüfung:

Private Sub Workbook_Open()
Dim wks As Worksheet
Dim verfall As Date
verfall = „12.05.2005“
For Each wks In Worksheets
If Date

6

wie schon Franz anklingen lies:

der Code gehört in:

Diese Arbeitsmappe

mfg
Spaguzzi

7

Irgendwie klappt mein Posten nicht. Ich schreibe jetzt zum DRITTEN MAL. Hoffe, dass es nun ankommt:

Kurz geschrieben: Code muss bei Datumsprüfung Problem haben - es wird das Blatt IMMER geschützt - egal welches Datuim in B2 steht.

Siehe: http://www.edvpeter.at/blattschutz.xls

Danke - Peter

[Bei dieser Antwort wurde das Vollzitat nachträglich automatisiert entfernt]

8

Irgendwie klappt mein Posten nicht. Ich schreibe jetzt zum
DRITTEN MAL. Hoffe, dass es nun ankommt:

Kurz geschrieben: Code muss bei Datumsprüfung Problem haben -
es wird das Blatt IMMER geschützt - egal welches Datuim in B2
steht.

Siehe: http://www.edvpeter.at/blattschutz.xls

Danke - Peter

Hallo Peter,

ich sehe du wendest jetzt meinen Vorschlag an. Freut mich.

Bei meinem Vorschlag muß du das Verfalldatum in Zelle B1 eintragen!!! Falls du gerne Zelle B2 verwenden möchtest, dann muß du in den Makros jeweils B1 durch B2 bzw. $B$1 durch $B$2 ersetzen.

Die Makros sehen dann so aus:

Private Sub Worksheet\_Activate()
 Dim Verfalldatum As Date
 Verfalldatum = Application.Range(" **B2**").Value
 If Date \>= Verfalldatum Then
 ActiveSheet.Protect Password:="Passwort", DrawingObjects:=True, Contents:=True, Scenarios:=True
 MsgBox ("Tabelle ist geschützt")
 End If
End Sub

Private Sub Worksheet\_SelectionChange(ByVal Target As Excel.Range)
 If Target.Address = " **$B$2**" Then
 If InputBox("Kennwort?", "Zellwert ändern", "\*\*\*") "Passwort" Then GoTo NaechsteZelle
 ActiveSheet.Unprotect Password:="Passwort"
 Target.Value = CDate(InputBox("Verfalldatum?", "Zellwert ändern", Format(Target.Value, "DD.MM.YYYY")))
NaechsteZelle:
 ActiveCell.Offset(1, 0).Select
 End If
End Sub

„Passwort“ solltes du natürlich durch eine eigene Kreation ersetzen. Falls du ganz auf Nummer sicher gehen willst, dann muß du auch das VBA-Project schützen (im VBA-Editor VBA-Project anklicken, rechte Maustaste–> VBA-Projetc-Eigenschaften --> Schutz --> Projekt für Anzeige sperren aktivieren und Passwort eingeben).

Gruß
Franz

1 „Gefällt mir“
9

DANKE - KLAPPT!
Die Sache klappt! - Danke!