AW: Öffnen nur für bestimmte Benutzer
06.06.2007 23:05:17
Matthias
Hallo Mat,
nimm in deiner Mappe ein Blatt, welches bei deaktivierten Makros angezeigt werden soll, nenne es "Hinweis".
Schreibe darauf einen entsprechenden Hinweis, dass die Mappe nur mit aktivierten Makros geöffnet werden kann.
Gib dann in diesem Blatt einem Bereich (z.B. A1:A20) den Namen "Benutzer" und schreibe alle erlaubten Benutzer rein (Windows-Anmeldename). Die spalte kannst du anschließend ausblenden.
Dann in DieseArbeitsmappe diesen Code:
' Mappe nur mit aktivierten Makros öffnen
' Anleitung:
' Erstelle in der betreffenden Mappe ein Blatt mit Namen "Hinweis"
' (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 = "Hinweis" '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()
If Not UserOK Then
Application.EnableCancelKey = xlDisabled
MsgBox "Sie sind nicht berechtigt, die Mappe zu öffnen", vbCritical
Application.EnableCancelKey = xlInterrupt
Me.Close False
End If
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
Function UserOK() As Boolean
Const ber = "Benutzer"
Dim z As Range, usr As String
usr = UCase(Environ("USERNAME"))
For Each z In Range("Benutzer")
If UCase(z) = usr Then UserOK = True: Exit Function
Next z
UserOK = False
End Function
Gruß Matthias