' Mappe nur mit aktivierten Makros öffnen
' Anleitung:
' Erstelle in der betreffenden Mappe ein Blatt mit Namen "Warnung"
' (Konstante OhneMakros kann angepasst werden)
' schreibe auf dieses Blatt eine Info, dass die Makros aktiviert sein müssen,
' um mit der Mappe zu arbeiten
' kopiere folgenden Code ins Modul "DieseArbeitsmappe"
Option Explicit
Const OhneMakros = "Warnung" 'Name des Blattes mit der Info
Const pwWarnung = "12345" 'Kennwort des Blattes mit der Info
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If Me.Saved = False Then
Select Case MsgBox("Sollen Ihre Änderungen in '" & Me.Name & "' gespeichert werden?", vbYesNoCancel + vbExclamation)
Case vbYes
Speichern
Case vbNo
Me.Saved = True
Case vbCancel
Cancel = True
End Select
End If
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Cancel = True
If SaveAsUI Then
MsgBox "Speichern unter... nicht möglich!" 'müsste falls erforderlich noch erweitert werden
Else
Speichern
End If
End Sub
Private Sub Workbook_Open()
AllesEinblenden
On Error Resume Next
'beim Speichern gemerktes aktives Blatt anzeigen:
Sheets(Sheets(OhneMakros).Cells(Rows.Count, Columns.Count).Value).Activate
Me.Saved = True
End Sub
Private Sub AllesAusblenden()
Dim sh As Worksheet
Sheets(OhneMakros).Visible = True
For Each sh In Me.Worksheets
If sh.Name <> OhneMakros Then sh.Visible = xlSheetVeryHidden
Next sh
End Sub
Private Sub AllesEinblenden()
Dim sh As Worksheet
For Each sh In Me.Worksheets
sh.Visible = True
Next sh
Sheets(OhneMakros).Visible = xlSheetVeryHidden
End Sub
Private Sub Speichern()
Dim sh As Worksheet
Dim fehler As Boolean
Set sh = ActiveSheet
'geöffnetes Blatt merken:
With Sheets(OhneMakros)
.Unprotect Password:=pwWarnung
.Cells(Rows.Count, Columns.Count) = sh.Name
.Protect Password:=pwWarnung
End With
Application.EnableEvents = False
Application.ScreenUpdating = False
AllesAusblenden
On Error Resume Next
Me.Save
If Err.Number > 0 Then
MsgBox Err.Description, , "Fehler " & Err.Number
fehler = True
End If
On Error GoTo 0
AllesEinblenden
sh.Activate
Application.EnableEvents = True
Application.ScreenUpdating = True
If Not fehler Then Me.Saved = True
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Tabelle3.Visible = xlSheetVisible
Tabelle3.Activate
Tabelle1.Visible = xlSheetVeryHidden
End Sub
Private Sub Workbook_Open()
Tabelle1.Visible = xlSheetVisible
Tabelle1.Activate
Tabelle3.Visible = xlSheetVeryHidden
End Sub
Private Sub workbook_open()
Dim objSh As Worksheet
Dim unam As String
If ThisWorkbook.ReadOnly Then ThisWorkbook.Close False
Application.ScreenUpdating = False
Dim blnFound As Boolean
unam = Environ("Username")
If unam = "richard.kuhn" Or unam = "alexa.theis" Then
For Each objSh In Me.Worksheets
objSh.Visible = xlSheetVisible
Next
Else
For Each objSh In Me.Worksheets
If objSh.Name = unam Then
blnFound = True
Exit For
End If
Next
If blnFound = True Then
objSh.Visible = xlSheetVisible
Else
ThisWorkbook.Close False
End If
Application.ScreenUpdating = True
End If
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.ScreenUpdating = True
End Sub