AW: "Komische" Fehlermeldung "Nach End Sub, End Functi
Sven
Hallo,
habe hier mal den Code aus "Diese Arbeitsmappe"
Option Explicit
Private Sub Workbook_Open()
Dim sh As Worksheet
Dim datDatum_Zeit As Date, lngDifferenz As Long
Stand = Application.DisplayFormulaBar
datDatum_Zeit = GetSetting(ThisWorkbook.Name, "gesperrt", "Datum und Zeit", Time)
lngDifferenz = DateDiff("n", Now, datDatum_Zeit)
If lngDifferenz > 0 Then
MsgBox "Sie wurden für die Benutzung der Mappe gesperrt." & vbLf & "Die Mappe wird in " & CStr(lngDifferenz) & " Minuten wieder freigeschaltet.", 64, "Information"
ThisWorkbook.Saved = True
If Workbooks.Count <= 1 Then Application.Quit Else ThisWorkbook.Close
Else
For Each sh In ActiveWorkbook.Worksheets
sh.Unprotect
Next sh
Sheets("Übersicht").Select
Range("I3").Value = ""
For Each sh In ActiveWorkbook.Worksheets
sh.Protect
Next sh
ThisWorkbook.IsAddin = False
End If
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim i As Integer
Dim j As Integer
'Wenn es Suchkatalogblätter gibt...
For j = Worksheets.Count To 1 Step -1
If Left(Worksheets(j).Name, 5) = "Such_" Then
With frmSuchblätterLöschen
.Show
'Wenn Anwender 'Abbrechen' gewählt hat, dann...
If .Tag = "Abbruch" Then
Sheets("Übersicht").Select
If Range("I3").Value = "Sperrung" Then
Application.DisplayAlerts = False
ThisWorkbook.Save
Application.DisplayAlerts = True
Exit Sub
End If
Cancel = True
'... Makro beenden
End
End If
'Wenn Anwender 'Ja' gewählt hat, dann...
If .Tag = "Ja" Then
'...werden die Suchkatlaogblätter gelöscht, die Arbeitsmappe gespeichert
'und geschlossen
Application.DisplayAlerts = False
For i = Worksheets.Count To 1 Step -1
If Left(Worksheets(i).Name, 5) = "Such_" Then
Worksheets(i).Delete
End If
Next i
ThisWorkbook.Save
Application.DisplayAlerts = True
Exit Sub
End If
'Wenn Anwender 'Nein' gewählt hat, dann...
If .Tag = "Nein" Then
'...Arbeitsmappe gespeichert und geschlossen ohne die Suchkatalogblätter zu löschen
ThisWorkbook.Save
Exit Sub
End If
End With
Else
'Wenn es keine Suchkatalogblätter gibt, wird die Mappe gespeichert und geschlossen
ThisWorkbook.Save
Exit Sub
End If
Next
End If
Application.DisplayAlerts = True
End Sub
Sub Leisten_(AnAus As Boolean)
Application.ScreenUpdating = False
For Each symbol In Application.CommandBars
symbol.Enabled = AnAus
Next symbol
Application.ScreenUpdating = True
If AnAus = False Then
Application.DisplayFormulaBar = False
Else
Application.DisplayFormulaBar = Stand
End If
End Sub
Private Sub Einblenden()
Notmakro zum einblenden der Symboleisten
Leisten_ True
End Sub
Private Sub Workbook_Deactivate()
Leisten_ True
End Sub
Private Sub Workbook_Activate()
Leisten_ False
End Sub