|
Das "ganze Teil" ist ein kleines Excel, wo im Prinzip ja alles viel klarer ersichtlich ist, als wenn ich es hier poste, oder? Aber ich kann es gerne probieren:
In "Diese Arbeitsmappe":
Option Explicit ' Variablendefinition erforderlich
'**************************************************
'* H. Ziplies *
'* 16.04.08 *
'* erstellt von HajoZiplies@web.de *
'* http://Hajo-Excel.de/ *
'**************************************************
Private Sub Workbook_Open()
With Sheets("xyz")
' Ablaufdatum beim ersten Öffen eintragen
If .Range("A1") = "" And Environ("Username") _
<> "Hajo_Zi" Then .Range("A1") = Date + 30
' Ablauflaufdatum prüfen
If .Range("A1") <> "" And Date > CDate(.Range("a1")) Then
MsgBox "Ihre Testphase ist abgelaufen," _
& vbCr & "bitte wenden Sie sich an Ihren Administrator.", _
48, "Ablaufdatum"
ThisWorkbook.Close False
End If
' Tabellen einblenden
blenden -1 ' Tabellen einblenden
Worksheets("Tabelle1").Select ' damit diese Tabelle beim Start angezeigt wird
' damit das einblenden der Register nicht als Veränderung
' der Datei angesehen wird Schalter Veränderung der
' Datei zurückstellen
ThisWorkbook.Saved = True ' Datei sichern
End With
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If ThisWorkbook.Saved Then Exit Sub
If InSpeicher = 1 Then Exit Sub
InSpeicher = 1
If MsgBox("Wollen Sie die Veränderungen speichern?", vbYesNo + _
vbQuestion, "Speichern ?") = vbYes Then
blenden 2
Else
ThisWorkbook.Saved = True
End If
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If SaveAsUI Then
Dim StDateiname As String
' With da Zeile sonst zu lang
With Application
StDateiname = _
.GetSaveAsFilename(fileFilter:="Excel-Arbeitsmappen (*.xls), *.xls")
End With
' ein Dateinmae wurde eingegeben
If UCase(StDateiname) <> "FALSCH" Then
' Reaktion auf Zellveränderung abschalten
Application.EnableEvents = False
ThisWorkbook.SaveAs Filename:=StDateiname
' Reaktion auf Zellveränderung einschalten
Application.EnableEvents = True
End If
Cancel = True ' speichern unter Dialog abbrechen
End If
Application.ScreenUpdating = False ' Bildschirmaktualisierung aus
If StTabelle = "" Then
StTabelle = ActiveSheet.Name
' ausblenden aller Register außer Sheets("Makros_deaktiviert")
' mit xlVeryHidden (2) dies hat den Vorteil, sie können nur per
' VBA eingeblendet werden.
blenden 2 ' Tabellen ausblenden
Cancel = True
End If
Application.ScreenUpdating = True ' Bildschirmaktualisierung ein
' damit das einblenden der Register nicht als Veränderung
' der Datei angesehen wird Schalter Veränderung der Datei zurückstellen
ThisWorkbook.Saved = True ' Datei sichern
End Sub
Und in Module "mdl_Makro_aktiv"
Option Explicit ' Variablendefinition erforderlich
' das Projekt muss nicht als Private definiert werden
' das Makro kann nur mit Parameter aufgerufen werden
'**************************************************
'* H. Ziplies *
'* 04.02.07 *
'* erstellt von HajoZiplies@web.de *
'* http://Hajo-Excel.de/ *
'**************************************************
Public StTabelle As String ' ausgewählte Tabelle
Public InSpeicher As Integer ' Datei wird geschlossen
Dim InI As Integer ' Zählvariable für Register
Sub blenden(InZustand As Integer)
'ActiveWorkbook.Unprotect ("Passwort")
' alle Tabellen einblenden vom letzten bis zum ersten
' bis auf Hinweistabelle
If InZustand = 2 Then _
Sheets("Makros_deaktiviert").Visible = -1
For InI = Sheets.Count To 1 Step -1
If Sheets(InI).Name <> "Makros_deaktiviert" _
And Sheets(InI).Name <> "xyz" Then _
Sheets(InI).Visible = InZustand
Next InI
' Tabelle mit Hinweis ein- bzw. ausblenden
' Tabelle ausblenden
If InZustand <> 2 Then Sheets("Makros_deaktiviert").Visible = 2
If StTabelle <> "" Then
If Sheets(StTabelle).Visible = -1 Then ' Tabelle ist sichtbar
' vor speichern gewählte Tabelle wieder aktivieren
Sheets(StTabelle).Select
StTabelle = "" ' Variable zurücksetzen
End If
End If
' Tabellen wurden ausgelendet, Datei sichern
If InZustand = 2 Then
Application.EnableEvents = False
'ActiveWorkbook.Protect ("Passwort")
ThisWorkbook.Save
Application.EnableEvents = True
If InSpeicher <> 1 Then blenden -1
End If
End Sub
|