AW: Das ".Save" muss dann an eine...
15.01.2019 21:02:44
Bernd
Hallo Case,
vielen Dank für Deine hilfe.
jetzt geht fast gar nichts mehr, habe das alte mit "'" Deaktivert, das neue eingefügt, jetzt bekomme ich für fehler im Debugger. Habe schon einiges Versucht, bekomme es nicht so hin.
Bei normalem schliessen,also im Aktivem zeitraum, sollte geschlossen werden ohne speichern und ohne nachfrage ob gespeichert werden sollte. Wenn es möglich ist, sollte nur ich (über USer ID) die frage bekommen ob ich speichern möchte
Ich hänge mal den Code dran. Hoffe Du kannst mir dabei noch mal Helfen.
Vielen Dank schon mal im voraus
Bernd
---------------------------------------------------
Private Sub Workbook_Open()
Dim wksSheet As Worksheet
On Error GoTo Fin
Application.ScreenUpdating = False
With ThisWorkbook
If Date = "31.12.2019" Then ' Datum anpassen!!!!
Application.DisplayAlerts = False
For Each wksSheet In .Worksheets
If wksSheet.Visible = 2 Then wksSheet.Visible = 0
' Tabellenblattname anpassen!!!!
If wksSheet.Name "Startblatt" Then
wksSheet.Delete
End If
Next wksSheet
.Save
'.Close False ' Gleich schliessen
End If
End With
Fin:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Dim strBerechtigt As String
strBerechtigt = Environ("Username")
Application.ScreenUpdating = False
If WorksheetFunction.CountIf(Worksheets("Berechtigungen").Columns(2), strBerechtigt) > 0 Then
If strBerechtigt = "P474HYU" Then
Worksheets("Startblatt").Visible = True
Worksheets("Fahrzeug1").Visible = True
Worksheets("Fahrzeug2").Visible = True
Worksheets("Fahrzeug3").Visible = True
Worksheets("ZRB").Visible = True
Worksheets("DispoÜbergabe").Visible = True
Worksheets("ZRB-Eingang 1-20").Visible = True
Worksheets("ZRB-Eingang 21-40").Visible = True
Worksheets("Stofftabelle").Visible = True
Worksheets("Berechtigungen").Visible = True
Worksheets("Adressen").Visible = True
Else
Worksheets("Startblatt").Visible = False
Worksheets("Fahrzeug1").Visible = True
Worksheets("Fahrzeug2").Visible = True
Worksheets("Fahrzeug3").Visible = True
Worksheets("ZRB").Visible = True
Worksheets("DispoÜbergabe").Visible = True
Worksheets("ZRB-Eingang 1-20").Visible = True
Worksheets("ZRB-Eingang 21-40").Visible = True
Worksheets("Stofftabelle").Visible = fals
Worksheets("Berechtigungen").Visible = fals
End If
Else
MsgBox "Sie sind nicht berechtigt die Datei zu öffnen."
ThisWorkbook.Close False
End If
Sheets("Fahrzeug1").ScrollArea = "A$1:$S$74"
Sheets("Fahrzeug2").ScrollArea = "A$1:$S$74"
Sheets("Fahrzeug3").ScrollArea = "A$1:$S$74"
Sheets("ZRB").ScrollArea = "A$1:$O$53"
'Sheets("DispoÜbergabe").ScrollArea = "A$1:$G$41"
Sheets("ZRB-Eingang 1-20").ScrollArea = "A$1:$K$30"
Sheets("ZRB-Eingang 21-40").ScrollArea = "A$1:$K$30"
Application.CalculateFull
End Sub
'speichern
'
Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Dim ws As Worksheet
'For Each ws In ThisWorkbook.Worksheets
' If ws.Name = "Startblatt" Then
' ws.Visible = True
' Else
' ws.Visible = xlVeryHidden
' ThisWorkbook.Close savechange: fals
' End If
'Next ws
'End Sub
'-------------------------------------------------------------------
'
Private Sub Workbook_Open()
'Dim strBerechtigt As String
'strBerechtigt = Environ("Username")
'Application.ScreenUpdating = False
'If WorksheetFunction.CountIf(Worksheets("Berechtigungen").Columns(2), strBerechtigt) > 0 Then
' If strBerechtigt = "P474HYU" Then
' Worksheets("Startblatt").Visible = True
' Worksheets("Fahrzeug1").Visible = True
' Worksheets("Fahrzeug2").Visible = True
' Worksheets("Fahrzeug3").Visible = True
' Worksheets("ZRB").Visible = True
' Worksheets("DispoÜbergabe").Visible = True
' Worksheets("ZRB-Eingang 1-20").Visible = True
' Worksheets("ZRB-Eingang 21-40").Visible = True
' Worksheets("Stofftabelle").Visible = True
' Worksheets("Berechtigungen").Visible = True
' Worksheets("Adressen").Visible = True
' Else
' Worksheets("Startblatt").Visible = False
' Worksheets("Fahrzeug1").Visible = True
' Worksheets("Fahrzeug2").Visible = True
' Worksheets("Fahrzeug3").Visible = True
' Worksheets("ZRB").Visible = True
' Worksheets("DispoÜbergabe").Visible = True
' Worksheets("ZRB-Eingang 1-20").Visible = True
' Worksheets("ZRB-Eingang 21-40").Visible = True
' Worksheets("Stofftabelle").Visible = Fals
' Worksheets("Berechtigungen").Visible = Fals
' End If
'Else
' MsgBox "Sie sind nicht berechtigt die Datei zu öffnen."
' ThisWorkbook.Close False
'End If
' Sheets("Fahrzeug1").ScrollArea = "A$1:$S$74"
' Sheets("Fahrzeug2").ScrollArea = "A$1:$S$74"
' Sheets("Fahrzeug3").ScrollArea = "A$1:$S$74"
' Sheets("ZRB").ScrollArea = "A$1:$O$53"
' 'Sheets("DispoÜbergabe").ScrollArea = "A$1:$G$41"
' Sheets("ZRB-Eingang 1-20").ScrollArea = "A$1:$K$30"
' Sheets("ZRB-Eingang 21-40").ScrollArea = "A$1:$K$30"
' Application.CalculateFull
'AB HIER LAUFZEIT
'Dim wksSheet As Worksheet
' On Error GoTo Fin
' Application.ScreenUpdating = False
' With ThisWorkbook
' If Date = "31.12.2019" Then ' Datum anpassen!!!!
' Application.DisplayAlerts = False
' For Each wksSheet In .Worksheets
' If wksSheet.Visible = 2 Then wksSheet.Visible = 0
' Tabellenblattname anpassen!!!!
' If wksSheet.Name "Startblatt" Then
' wksSheet.Delete
' End If
' Next wksSheet
' End If
' .Save
'.Close False ' Gleich schliessen
' End With
'Fin:
' Application.ScreenUpdating = True
' Application.DisplayAlerts = True
'End Sub
'--------------------------------------------------------------
'-SPEICHERN NUR MIT PWD MÖGLICH
'Option Explicit
'
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'Dim speichern As String
'speichern = InputBox("Speichern ist nur nach Eingabe" & Chr(10) & "eines Passworts möglich !")
'If speichern = "BBSUN99" Then
'Exit Sub
'Else
'MsgBox ("Falsches Passwort bzw. Speicherung abgebrochen !")
'Cancel = True
'End If
'End Sub
'----------------------------------------------------------------