AW: zeitliche Begrenzung
Veit
versuche mal diesen Weg:
'Diesen Code in "DieseArbeitsmappe" nicht Tabelle, nicht Modul
'Funktion:
' Beim schließen der Mappe wird:
'1. ein neues Blatt als "warnung" hinzugefügt und
'2. alle anderen Blätter ausgeblendet
'3. die Änderungen gespeichert
' Beim Öffnen der Mappe wird:
'0. Wenn Mappe ohne aktivierte Makros gestartet wird, sieht der User nur das Warnblatt
'1. Kontrolliert ob Verfallsdatum überschritten ist wenn ja dann Abbruch --> Blätter werden nicht sichtbar, User hat eine Datei mit der er nichts anfangen kann
'2. wenn noch Zeit ist, dann einblenden aller Blätter
'3. Löschen des temporären "Frist-Makro"-Blattes
' Wichtig:
'der VBA-Code muß natürlich Pswd-geschützt sein.
Private Sub Workbook_BeforeClose(Cancel As Boolean) 'beim schließen der Mappe
'Application.EnableCancelKey = xlDisabled 'keine Fehlerbehandlung
Sheets.Add Before:=Worksheets(Worksheets.Count) 'Blatt dazu
Sheets(1).Name = "Frist-Makros" 'und benennen
With Sheets("Frist-Makros")
For i = 1 To 10 Step 2 'ein bisschen was als Info auf das Blatt schreiben
If Date > "12.06.2004" Then 'abhängig vom Datum
.Cells(i, i).Value = "Der Testzeitraum ist abgelaufen.."
Else
.Cells(i, i).Value = "Bitte starten Sie die Datei mit aktivierten Makros neu."
End If
Next i
End With
For i = 1 To Worksheets.Count 'alle Blätter ausser Blatt(Frist-Makros) ausblenden (und das gründlich)
If Sheets(i).Name <> "Frist-Makros" Then Worksheets(i).Visible = xlVeryHidden
Next i
Application.DisplayAlerts = False
ActiveWorkbook.Save 'Änderungen speichern
Application.DisplayAlerts = True
'Application.EnableCancelKey = xlInterrupt 'anschalten der Fehlerbehandlung
End Sub
Private Sub Workbook_Open() 'beim Öffnen der Mappe
Application.EnableCancelKey = xlDisabled 'keine Fehlerbehandlung
If Date > "12.06.2004" Then 'wenn das Ende-Datum erreicht wurde
MsgBox "Der Testzeitraum ist abgelaufen." 'Info
Application.EnableCancelKey = xlInterrupt 'anschalten der Fehlerbehandlung
Exit Sub 'verlassen der Routine --> Blätter werden nicht eingeblendet
End If
For i = 1 To Worksheets.Count 'alle Blätter einblenden
Worksheets(i).Visible = True
Next i
Application.DisplayAlerts = False 'ausschalten der Abfrage ob ja oder nein
Sheets("Frist-Makros").Delete 'Sonderblatt löschen
Application.DisplayAlerts = True 'anschalten der Bildschirmdialoge
Application.EnableCancelKey = xlInterrupt 'anschalten der Fehlerbehandlung
End Sub
Gruß
Ein Veit