AW: (fast) alle Blätter ausblenden ohne Speichern?
29.09.2012 18:44:51
fcs
Hallo raspi,
du kanst mit dem before_Save arbeiten.
Vor dem Speichern werden die sichtbaren Blätter ermittelt, dann alle Blätter bis auf das Start-Blatt ausgeblendet und gespeichert. Anschließend die vorher sichtbaren Blätter wieder eingeblendet und der Speichern-Status auf gespeichert gesetzt.
Ein Sonderfall muss noch eingearbeitet werden, wenn bei der Sicherheitsabfrage beim Schliessen doch noch gespeichert werden soll.
Gruß
Franz
'Code unter diese Arbeitsmappe
Option Explicit
Dim bolClose As Boolean
Private Sub Workbook_BeforeClose(Cancel As Boolean)
bolClose = True
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim arrVisible() As Long, iIndex As Integer, objSh As Object
ReDim arrVisible(1 To Me.Sheets.Count)
'Aktives Blatt merken
Set objSh = ActiveSheet
Application.ScreenUpdating = False
'aktuellen Sichtbar-Status merken
For iIndex = 1 To Me.Sheets.Count
arrVisible(iIndex) = Me.Sheets(iIndex).Visible
Next
'alle Blätter außer Blatt "Start" ausblenden
Me.Sheets("Start").Visible = xlSheetVisible
For iIndex = 1 To Me.Sheets.Count
If Me.Sheets(iIndex).Name "Start" Then
If Me.Sheets(iIndex).Visible xlSheetVeryHidden Then
Me.Sheets(iIndex).Visible = xlSheetVeryHidden
End If
End If
Next
If bolClose = False Then
'Datei Speichern
Application.EnableEvents = False
Me.Save
Cancel = True
Application.EnableEvents = True
'vorher sichtbare Blätter wieder einblenden
For iIndex = 1 To Me.Sheets.Count
If arrVisible(iIndex) = xlSheetVisible Then Me.Sheets(iIndex).Visible = xlSheetVisible
Next
objSh.Activate
'gespeichert Status auf True setzen
Me.Saved = True
End If
Application.ScreenUpdating = True
Erase arrVisible
bolClose = False
End Sub