AW: Excel Mappe Sperren
17.03.2005 15:50:00
Matthias
Hallo Tino,
Ein wenig kompliziert, v.a. wenn es auch ohne Makros funktionieren soll.
In DieseArbeitsmappe:
Option Explicit
Private Sub MappeSpeichern(Optional fn)
Dim Sh As Worksheet
Dim bo As Boolean
Set Sh = ActiveSheet
On Error GoTo Fehler
Application.ScreenUpdating = False
If IsMissing(fn) Then
ZeigeHinweis
Application.StatusBar = "Speichert '" & ThisWorkbook.Name & "'..."
Application.EnableEvents = False
ThisWorkbook.Save
Else
ZeigeHinweis
Application.EnableEvents = False
Application.StatusBar = "Speichert '" & fn & "'..."
ThisWorkbook.SaveAs fn
End If
Fehler:
VersteckeHinweis
Sh.Activate
Application.StatusBar = False
Application.ScreenUpdating = True
If Err.Number > 0 Then MsgBox Err.Description
Application.EnableEvents = True
End Sub
Private Sub ZeigeHinweis()
Dim i As Integer
Sheets(Sheets.Count).Visible = True
For i = 1 To Sheets.Count - 1
Sheets(i).Visible = xlSheetVeryHidden
Next i
End Sub
Private Sub VersteckeHinweis()
Dim i As Integer, Sa As Boolean
Sa = ThisWorkbook.Saved
For i = 1 To Sheets.Count - 1
Sheets(i).Visible = True
Next i
Sheets(Sheets.Count).Visible = xlSheetVeryHidden
ThisWorkbook.Saved = Sa
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim aw
If Not ThisWorkbook.Saved Then
aw = MsgBox("Sollen ihre Änderungen in '" & ThisWorkbook.Name & "' gespeichert werden?", vbYesNoCancel + vbExclamation)
If aw = vbYes Then
MappeSpeichern
ElseIf aw = vbNo Then
ThisWorkbook.Saved = True
Else 'Abbrechen
Cancel = True
End If
End If
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim fn
Cancel = True
If SaveAsUI Then
fn = Application.GetSaveAsFilename(ThisWorkbook.Name, "Excel-Dateien (*.xls), *.xls", , "Datei speichern")
If fn = False Then Exit Sub
MappeSpeichern fn
Else
MappeSpeichern
End If
End Sub
Private Sub Workbook_Open()
Dim User As String
User = UCase(Environ("USERNAME"))
Application.EnableCancelKey = xlDisabled
If User <> "MAIER" And User <> "EMIL" Then
Application.ScreenUpdating = False
MsgBox "Keine Zugangsberechtigung für " & User & "!", vbCritical
Application.EnableCancelKey = xlInterrupt
ThisWorkbook.Saved = True
If Workbooks.Count > 1 Then
ThisWorkbook.Close SaveChanges:=False
Else
Application.Quit
End If
End If
Application.EnableCancelKey = xlInterrupt
VersteckeHinweis
Sheets(1).Activate
ThisWorkbook.Saved = True
End Sub
Voraussetzungen:
1. Das letzte Tabellenblatt enthält lediglich einen gut sichtbaren Hinweis, dass die Mappe nur mit aktivierten Makros zu starten ist.
2. Der VBA-Code muss durch Kennwort geschützt sein.
Gruß Matthias