Makroaktivierung erforderlich für weitere Bearbeitung
#1
Hallo,

ich habe etwas gefunden, das würde ich gerne in meine Datei mit einbauen.

Ziel ist es, dass eine Startblatt offen bleibt, solange man nicht die Markos aktiviert. Wenn Makros aktiv sind dann schließt das Blatt sich automatisch und man kann mit dem eigentlichen Blatt weiter machen.

Dieses müsste ich in "DieseArbeitsmappe" einfügen:

Code:
Option Explicit
Dim wks
Private Sub Workbook_Open()
Application.ScreenUpdating = False
For Each wks In ActiveWorkbook.Sheets
       wks.Visible = True
   Next
Sheets("Start").Visible = xlVeryHidden
Application.ScreenUpdating = True
startzeit
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal sh As Object, ByVal Target As Range)
startzeit
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.ScreenUpdating = False
Sheets("Start").Visible = True
For Each wks In ActiveWorkbook.Sheets
       If wks.Name <> "Start" Then wks.Visible = xlVeryHidden
Next
Application.ScreenUpdating = True
Zurücksetzen
End Sub

und dieses in ein Modul:
Code:
Option Explicit
Dim datA As Date

Sub startzeit()
On Error Resume Next
Application.OnTime EarliestTime:=datA, Procedure:="Schließen", Schedule:=False
datA = Now + CDate("0:01:00")
Application.OnTime datA, "Schließen"
End Sub

Sub Schließen()
ActiveWorkbook.Close True
End Sub

Sub Zurücksetzen()
Application.OnTime EarliestTime:=datA, Procedure:="Schließen", Schedule:=False
End Sub

jetzt hab ich allerdings in "DieseArbeitsmappe" etwas stehen, was sich dann überschneidet und es gibt eine Fehlermeldung. Kann mir wer sagen wie ich dieses kombinieren kann ?

"DieseArbeitsmappe" in meiner Datei:

Code:
Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Application.OnTime dteCloseTime, "DoClose", , False
End Sub

Private Sub Workbook_Open()
dteCloseTime = Now + TimeSerial(0, 10, 0)
Application.OnTime dteCloseTime, "DoClose"
End Sub

Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)
On Error Resume Next
Application.OnTime dteCloseTime, "DoClose", , False
dteCloseTime = Now + TimeSerial(0, 10, 0)
blnCloseNow = False
Application.OnTime dteCloseTime, "DoClose"
End Sub

Private Sub Workbook_SheetDeactivate(ByVal sh As Object)
On Error Resume Next
Application.OnTime dteCloseTime, "DoClose", , False
dteCloseTime = Now + TimeSerial(0, 10, 0)
blnCloseNow = False
Application.OnTime dteCloseTime, "DoClose"
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal sh As Object, ByVal Target As Range)
On Error Resume Next
Application.OnTime dteCloseTime, "DoClose", , False
dteCloseTime = Now + TimeSerial(0, 10, 0)
blnCloseNow = False
Application.OnTime dteCloseTime, "DoClose"
End Sub
Top
#2
Hallo,

habe es mal ohne Kenntnis der Datei und der weiteren Hintergründe zum Code:
Code:
Option Explicit
Dim wks
Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Application.ScreenUpdating = False
Sheets("Start").Visible = True
For Each wks In ActiveWorkbook.Sheets
       If wks.Name <> "Start" Then wks.Visible = xlVeryHidden
Next
Application.ScreenUpdating = True
Application.OnTime dteCloseTime, "DoClose", , False
End Sub

Private Sub Workbook_Open()
dteCloseTime = Now + TimeSerial(0, 10, 0)
Application.OnTime dteCloseTime, "DoClose"

Application.ScreenUpdating = False
For Each wks In ActiveWorkbook.Sheets
       wks.Visible = True
   Next
Sheets("Start").Visible = xlVeryHidden
Application.ScreenUpdating = True

End Sub

Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)
On Error Resume Next
Application.OnTime dteCloseTime, "DoClose", , False
dteCloseTime = Now + TimeSerial(0, 10, 0)
blnCloseNow = False
Application.OnTime dteCloseTime, "DoClose"
End Sub

Private Sub Workbook_SheetDeactivate(ByVal sh As Object)
On Error Resume Next
Application.OnTime dteCloseTime, "DoClose", , False
dteCloseTime = Now + TimeSerial(0, 10, 0)
blnCloseNow = False
Application.OnTime dteCloseTime, "DoClose"
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal sh As Object, ByVal Target As Range)
On Error Resume Next
Application.OnTime dteCloseTime, "DoClose", , False
dteCloseTime = Now + TimeSerial(0, 10, 0)
blnCloseNow = False
Application.OnTime dteCloseTime, "DoClose"
End Sub
Gruß
Michael
Top
#3
Hi,

ich weiß nicht, ob das so geht:
ich würde generell alle Blätter außer dem Start-Blatt per Makro ausblenden und die Datei speichern.

Dann erst, wenn die Makros aktiviert werden, per Makro die Blätter einblenden und mit "Workbook_BeforeClose" die Blätter wieder ausblenden und speichern.
Top
#4
(20.12.2017, 13:02)Rabe schrieb: Hi,

ich weiß nicht, ob das so geht:
ich würde generell alle Blätter außer dem Start-Blatt per Makro ausblenden und die Datei speichern.

Dann erst, wenn die Makros aktiviert werden, per Makro die Blätter einblenden und mit "Workbook_BeforeClose" die Blätter wieder ausblenden und speichern.

was ist da jetzt anders?

Gruß Uwe
Top
#5
Hi,

hab das mal so eingesetzt und es funktioniert eigentlich ganz gut danke.
Wenn ich das ganze aber wieder schließe, öffnet sich das besagte Startblatt und er fragt mich ob ich speichern möchte... auch wenn ich nichts verändert habe.

Wenn dieses noch weg wäre dann wäre es perfekt.

Siehe Anhang....


Angehängte Dateien
.xlsm   Kopie von Fahrtenbuch Maverik-2.xlsm (Größe: 26,99 KB / Downloads: 6)
Top
#6
hat noch jemand eine Lösung dafür ?
Top
#7
Hallo,

vielleicht so:
Option Explicit

Dim wks

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim bolSaved As Boolean
On Error Resume Next
Application.ScreenUpdating = False
bolSaved = Me.Saved
Sheets("Start").Visible = True
For Each wks In Me.Sheets
If wks.Name <> "Start" Then wks.Visible = xlVeryHidden
Next wks
Me.Saved = bolSaved
Application.ScreenUpdating = True
Application.OnTime dteCloseTime, "DoClose", , False
End Sub

Private Sub Workbook_Open()
dteCloseTime = Now + TimeSerial(0, 10, 0)
Application.OnTime dteCloseTime, "DoClose"
Application.ScreenUpdating = False
For Each wks In Me.Sheets
wks.Visible = True
Next wks
Sheets("Start").Visible = xlVeryHidden
Application.ScreenUpdating = True
Me.Saved = True
End Sub
Gruß Uwe
Top
#8
Hi Kuwer,

erstmal danke.

Wenn ich jetzt nicht am Dokument ändere, schließt er es ohne Meldung. Das ist schon mal gut.
Wenn ich was dran ändere kommt die Meldung, muss ja auch so sein, es wird dann aber die Startseite angezeigt.

Könnte man dieses noch unterbinden? Ich kann mir vorstellen, dass dieses ein wenig verwirrend ist für die Nutzer der Datei....
Top
#9
Hm,

warum auch immer funktioniert es jetzt gerade gar nicht mehr. Vielleicht könnt ihr mal rein schauen.....


Angehängte Dateien
.xlsm   Kopie von Fahrtenbuch Maverik-2.xlsm (Größe: 57,29 KB / Downloads: 4)
Top
#10
Hallo,

probiere mal so:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Application.ScreenUpdating = False
Sheets("Start").Visible = True
For Each wks In Me.Sheets
If wks.Name <> "Start" Then wks.Visible = xlVeryHidden
Next wks
Me.Save
Application.ScreenUpdating = True
Application.OnTime dteCloseTime, "DoClose", , False
End Sub
Dadurch wird die Datei vor dem Schließen immer gespeichert.

Gruß Uwe
[-] Folgende(r) 1 Nutzer sagt Danke an Kuwer für diesen Beitrag:
  • Maverik000
Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste