AW: Makros aktivieren
28.12.2006 12:00:43
Matthias
Hallo Ute,
mein Vorschlag:
' 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
Gruß Matthias