Wie würdet Ihr einen Blattschutz ab Verfallsdatum einrichten? Gibt es da Standardfunktionen oder geht das nur mit VBA?
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
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
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]
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
wie schon Franz anklingen lies:
der Code gehört in:
Diese Arbeitsmappe
mfg
Spaguzzi
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]
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“
DANKE - KLAPPT!
Die Sache klappt! - Danke!