Re: Arbeitsmappeninhalte mit Zeitablauf löschen
29.12.2002 11:37:00
Ramses
Hallo,es heisst "aufwändigen" ;-)
Nun zu deinem Problem:
Was du auf jeden Fall einbauen solltest ist eine leere Tabelle ohne Gitternetzlinien. Bennene diese z.B. "Cover".
Nun setzt du eine Workbook_Close Ereignis ein, das diese Seite beim Schliessen auswählt und deine Arbeitsmappe und das Blatt schützt:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Deckblatt wählen
Worksheets("Cover").Select
'Zeilen- und Spaltebeschriftungen ausblenden
'Bildschirmlaufleisten ausblenden
'Registerblätter ausblenden
With ActiveWindow
.DisplayHeadings = False
.DisplayHorizontalScrollBar = False
.DisplayVerticalScrollBar = False
.DisplayWorkbookTabs = False
End With
'Arbeitsmappenaufbau und Blatt schützen
ActiveWorkbook.Protect Password:="Sicher", Structure:=True, Windows:=True
ActiveSheet.Protect Password:="Sicher", DrawingObjects:=True, Contents:=True, Scenarios:=True
End SubPrivate Sub Workbook_Open()
Dim PW As String
'Gültigkeit prüfen
If Date > "01.06.2003" Then
MsgBox "Nutzungsdauer abgelaufen"
Exit Sub
End If
'Oder Monatliche PW-Prüfung
PW = InputBox("Bitte Password für Monat " & Format(Month(Date), "MMMM") & " eingeben!", "Password")
Select Case Month(Date)
Case Is > 0 < 4
If PW <> "1.Quartal" Then
MsgBox "Passwort abgelaufen: Bitte Hern XY anrufen"
Exit Sub
End If
Case Is > 3 < 7
If PW <> "1.Quartal" Then
MsgBox "Passwort abgelaufen: Bitte Hern XY anrufen"
Exit Sub
End If
Case Is > 6 < 10
If PW <> "3.Quartal" Then
MsgBox "Passwort abgelaufen: Bitte Hern XY anrufen"
Exit Sub
End If
Case Is > 9 < 13
If PW <> "4.Quartal" Then
MsgBox "Passwort abgelaufen: Bitte Hern XY anrufen"
Exit Sub
End If
End Select
'Zeilen- und Spaltebeschriftungen einblenden
'Bildschirmlaufleisten einblenden
'Registerblätter einblenden
With ActiveWindow
.DisplayHeadings = True
.DisplayHorizontalScrollBar = True
.DisplayVerticalScrollBar = True
.DisplayWorkbookTabs = £True
End With
'Arbeitsmappenaufbau und Blatt schützen
ActiveWorkbook.Unprotect Password:="Sicher", Structure:=True, Windows:=True
ActiveSheet.Unprotect Password:="Sicher", DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub
Code eingefügt mit Syntaxhighlighter 1.16
Damit ist sichergestellt, dass wenn jemand beim öffnen die "Shift"-Taste gedrückt hält oder die Makros wegen der Sicherheitsabrage nicht aktiviert hat, beim öffnen trotzdem keinen Zugriff hat auf deine Tabelle hat.
Das Password kannst du dann ebenfalls im Workbook_Open Ereignis abfragen.
Durch das Close-Ereignis ist sichergestellt, dass die Arbeitsmappe auf jeden Fall geschützt ist.
Gruss Rainer