Automatisch afsluiten bestand

[CygneVoler]

In de bijlage heb ik een bestand toegevoegd dat na enige tijd automatisch afsluit.
Wanneer het bestand wordt geopend, wordt de gebruiker er op geattendeerd dat het bestand na enge tijd sluit.
5 seconden voor de eindtijd komt er een melding dat het bestand nu wordt afgesloten.
En...dat werkt.

Dit is echter mijn "test" bestand.

Wanneer ik de modules en thisworkbook commando's vanuit het testbestand knip en vervolgens plak in mijn "echte"bestand, komt er een fout 400 melding. (zie bijlage)

Heeft iemand enig idee wat ik over het hoofd zie?

Alvast hartelijk dank voor jullie denkwerk!

CooS

Thisworkbook "Test-bestand" :

Private Sub Workbook_Open()

    AutoSluiten.Show
    
    Call SetTimer
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call StopTimer
End Sub
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
    Call StopTimer
    Call SetTimer
End Sub

Thisworkbook "Echte-bestand"

Private Sub Workbook_Open()
 With Sheets("ARTIKELEN")
   .Visible = True
   .Cells(1).CurrentRegion.Sort .Cells(1, 3), , , , , , , xlYes
   .Visible = xlVeryHidden
  End With
  AutoSluiten.Show
    
    Call SetTimer
End Sub

'Private Sub Workbook_BeforeClose(Cancel As Boolean)
'For i = 6 To 6 'Sheets.Count
'Sheets(i).Protect Password:="test"
'Next
  Call StopTimer
'End Sub


Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
    Call StopTimer
    Call SetTimer
End Sub

Beide bestanden hebben de volgende "tekst" in de modulen"

Dim DownTime As Date

Sub SetTimer()
    DownTime = Now + TimeValue("00:00:30")
    WarningTime = DownTime - TimeValue("00:00:05")
      Application.OnTime WarningTime, "Afsluiten", , True
        Application.OnTime EarliestTime:=DownTime, _
      Procedure:="ShutDown", Schedule:=True
    
End Sub
Sub StopTimer()

    On Error Resume Next
    Application.OnTime EarliestTime:=DownTime, _
      Procedure:="ShutDown", Schedule:=False
 End Sub
Sub ShutDown()
    Application.DisplayAlerts = False
    With ThisWorkbook
        .Saved = True
        .Close
    End With
      End Sub
Sub Afsluiten()
WarningMessage.Show
End Sub

 

[HSV]

Heb je de codes van het formulier 'Autosluiten' er ook in opgenomen?

 

[CygneVoler]

Hoi Harry, dit heb ik in het formulier/userform staan autosluiten:

Private Sub UserForm_Activate()
t = Timer
Do While Timer < t + 9
    DoEvents
Loop
Unload Me
End Sub

Private Sub UserForm_QueryClose _
  (Cancel As Integer, CloseMode As Integer)
    If CloseMode = vbFormControlMenu Then
        MsgBox "Gewoon ff wachten...De melding gaat vanzelf weg!"
        Cancel = True
    End If
End Sub

Omdat ik graag wil dat de melding niet wordt weggeklikt heb ik een Query Close toegevoegd.

 

[HSV]

Het geplaatste bestand door jou werkt hier prima.
Is dit het origineel of de test?

 

[CygneVoler]

Dat klopt. Bij mij ook! Maar dit is de test. In het eerste bericht (#1) staan de codes in het "echte document"

 

[HSV]

En in het bestand van #1 krijg je de melding?
Hier niet.

 

[CygneVoler]

Misschien ben ik niet duidelijk geweest Harry. Sorry daarvoor. Maar het bestand wat is bijgevoegd aan dit bericht, is het testbestand. En dat werkt goed.
Maar wanneer ik de gegevens kopieer en plak in het "echte document" krijg ik de foutmelding.

 

[HSV]

Zo las ik het ook, vandaar de vraag of je de code van het formulier-module ook hebt overgenomen in het echte bestand.
Die zie ik er namelijk niet tussen staan.

 

[CygneVoler]

Oke, maar ja dat staat ook in het bestand. In de formulieren van de visual basic / userform.

 

[CygneVoler]

Het vreemde vind ik dat de 400 foutmelding verwijst naar de "WarningMessage.Show". Kom je daar verder mee?

 

[HSV]

Geef het formulier eens niet in modus.

WarningMessage.Show vbmodeless

 

[snb]

Gebruik in plaats van een userform dit voor de melding

CreateObject("Wscript.shell").Popup "wacht....", 5

 

[CygneVoler]

Harry, vreemd maar waar: hij sluit zonder melding af, maar daarna opent de file weer en sluit direct af! Magic? Het lijkt er verdacht veel op dat het bestand op een of andere manier, 2x wordt geopent.

SNB, dat werkt idd ook goed alleen moet je voor het afsluiten op OK drukken om het programma te laten sluiten. En ik had zo bedacht dat dat juist automatisch gaat. Waarom? Wanneer er iemand het programma open laat staan kan er niemand meer in om gegevens in te voeren. Vandaar...

 

[HSV]

Geen idee waarom het bestand opnieuw opent.

Bij de popup van @snb hoef je niet op Ok te drukken; deze sluit na 5 seconden.

Hier een variant:

Sub hsv()
Select Case CreateObject("WScript.Shell").Popup("wacht", 5, "Deze msgbox gaat weg na 5 seconden")
        Case 1 'is de OK knop
            CreateObject("WScript.Shell").Popup "hoe vaker je op ""Ok"" drukt des te langer het duurt", 3, "heb geduld"
            hsv
        Case -1 'is niets doen
    End Select
End Sub

 

[CygneVoler]

oké bedankt voor de toelichting. Ik ga kijken wat het beste werkt maar ook hier werd het bestand 2x geopend. Houd jullie op de hoogte.

 

[HSV]

Dan staat er vast nog meer code in die wij niet weten.
Plaats anders het origineel zonder gevoelige info.

 

[CygneVoler]

Ja Harry dat zou het makkelijkste zijn en zeker voor de hand liggend. Maar dat wordt wel heel lastig.

 

[CygneVoler]

#HSV, Harry ik moet hier toch werkelijk op OK drukken wil het programma sluiten. Deze sluiten niet na 5 sec!

 

[HSV]

Vreemd, ik kan er verder niets mee.

 

[CygneVoler]

Ik ook niet, haha. In ieder geval bedankt voor het meedenken.