Note: The other languages of the website are Google-translated. Back to English
Inloggen  \/ 
x
or
x
Registreer  \/ 
x

or

Hoe een werkmap opslaan en sluiten na een bepaalde tijd inactiviteit?

Soms kunt u per ongeluk een werkmap sluiten als u lange tijd met andere zaken bezig bent, waardoor belangrijke gegevens in de werkmap verloren kunnen gaan. Zijn er trucs om de werkmap automatisch op te slaan en te sluiten als je deze een bepaalde tijd hebt gedeactiveerd?

Werkmap automatisch opslaan en sluiten na inactiviteit gedurende een bepaalde tijd met VBA


pijl blauw rechts bel Werkmap automatisch opslaan en sluiten na inactiviteit gedurende een bepaalde tijd met VBA

Er is geen ingebouwde functie in Excel om dit probleem op te lossen, maar ik kan een macrocode introduceren die u kan helpen bij het opslaan en sluiten van een werkmap na inactiviteit binnen een bepaalde tijd.

1. Schakel de werkmap in die u automatisch wilt opslaan en sluit na enige seconden inactiviteit, en druk op Alt + F11 sleutels om te openen Microsoft Visual Basic voor toepassingen venster.

2. klikken Invoegen > Module om een ​​te maken Module script, en plak de onderstaande code erin. Zie screenshot:

Dim CloseTime As Date
Sub TimeSetting()
    CloseTime = Now + TimeValue("00:00:15")
    On Error Resume Next
    Application.OnTime EarliestTime:=CloseTime, _
      Procedure:="SavedAndClose", Schedule:=True
End Sub
Sub TimeStop()
    On Error Resume Next
    Application.OnTime EarliestTime:=CloseTime, _
      Procedure:="SavedAndClose", Schedule:=False
 End Sub
Sub SavedAndClose()
    ActiveWorkbook.Close Savechanges:=True
End Sub

 

doc opslaan werkmap sluiten na inactiviteit 1

3. Vervolgens in de Projectverkenner dubbelklik op het paneel Dit werkboek, en plak onderstaande code in het naast-script. Zie screenshot:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call TimeStop
End Sub

Private Sub Workbook_Open()
    Call TimeSetting
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
   Call TimeStop
   Call TimeSetting
End Sub

 

doc opslaan werkmap sluiten na inactiviteit 2

4. Ga naar dubbelklikken op de module die u in stap 2 hebt ingevoegd en druk op F5 sleutel om de code uit te voeren. Zie screenshot:
doc opslaan werkmap sluiten na inactiviteit 3

5. Na 15 seconden komt er een dialoogvenster tevoorschijn om u eraan te herinneren de werkmap op te slaan en te klikken Ja om de werkmap op te slaan en te sluiten.
doc opslaan werkmap sluiten na inactiviteit 4

Tips:

(1) In de eerste code kunt u de inactiviteitstijd wijzigen in een andere in deze string: Nu + Tijdwaarde ("00:00:15")

(2) Als u de werkmap nog nooit eerder hebt opgeslagen, kan het Opslaan als dialoogvenster verschijnt eerst en vraagt ​​u om het op te slaan.
doc opslaan werkmap sluiten na inactiviteit 5


goed Bescherm werkblad

Kutools voor Excel's Bescherm werkblad functie kan snel meerdere bladen of de hele werkmap tegelijk beveiligen.
doc beschermt meerdere werkbladen

De beste tools voor kantoorproductiviteit

Kutools voor Excel lost de meeste van uw problemen op en verhoogt uw productiviteit met 80%

  • visfuik: Snel invoegen complexe formules, grafieken en alles wat je eerder hebt gebruikt; Versleutel cellen met wachtwoord; Maak een mailinglijst en stuur e-mails ...
  • Super Formula-balk (bewerk eenvoudig meerdere regels tekst en formule); Lay-out lezen (gemakkelijk grote aantallen cellen lezen en bewerken); Plakken in gefilterd bereik...
  • Voeg cellen / rijen / kolommen samen zonder gegevens te verliezen; Gespleten cellen inhoud; Combineer dubbele rijen / kolommen... Voorkom dubbele cellen; Vergelijk Ranges...
  • Selecteer Dupliceren of Uniek Rijen; Selecteer lege rijen (alle cellen zijn leeg); Super zoeken en fuzzy zoeken in veel werkboeken; Willekeurige selectie ...
  • Exacte kopie Meerdere cellen zonder de formuleverwijzing te wijzigen; Maak automatisch verwijzingen naar meerdere bladen; Plaats kogels, Selectievakjes en meer ...
  • Extraheer tekst, Tekst toevoegen, Verwijderen op positie, Ruimte verwijderen; Paging-subtotalen maken en afdrukken; Converteren tussen celinhoud en opmerkingen...
  • Super filter (bewaar en pas filterschema's toe op andere bladen); Geavanceerd sorteren per maand / week / dag, frequentie en meer; Speciaal filter door vet, cursief ...
  • Combineer werkmappen en werkbladen; Tabellen samenvoegen op basis van sleutelkolommen; Gegevens splitsen in meerdere bladen; Batch Converteer xls, xlsx en PDF...
  • Meer dan 300 krachtige functies. Ondersteunt Office / Excel 2007-2019 en 365. Ondersteunt alle talen. Eenvoudig te implementeren in uw onderneming of organisatie. Gratis proefperiode van 30 dagen met volledige functies. 60 dagen geld-terug-garantie.
kte tabblad 201905

Office-tabblad Brengt een interface met tabbladen naar Office en maakt uw werk veel gemakkelijker

  • Schakel bewerken en lezen met tabbladen in Word, Excel, PowerPoint in, Publisher, Access, Visio en Project.
  • Open en maak meerdere documenten in nieuwe tabbladen van hetzelfde venster in plaats van in nieuwe vensters.
  • Verhoogt uw productiviteit met 50% en vermindert elke dag honderden muisklikken voor u!
officetab onderkant
Say something here...
symbols left.
You are guest
or post as a guest, but your post won't be published automatically.
Loading comment... The comment will be refreshed after 00:00.
  • To post as a guest, your comment is unpublished.
    Jason · 5 months ago
    This is great. Any tips on adding a popup message box that will warn the user the sheet is about to close and give them the option to reset the timer?
  • To post as a guest, your comment is unpublished.
    Xman · 10 months ago
    I'm not sure what happened but this solution no longer works. Here is the fix to this solution that worked for me:

    ````
    Dim resetCount As Long

    Public Sub Workbook_Open()
    On Error Resume Next
    Set xWB = ThisWorkbook
    resetCount = 0
    End Sub

    Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    On Error Resume Next
    Reset
    End Sub

    Sub Reset()
    On Error Resume Next
    Static xCloseTime
    If resetCount <> 0 Then
    ThisWorkbook.Application.OnTime xCloseTime, "SaveWork1", Schedule:=False
    resetCount = resetCount + 1
    xCloseTime = DateAdd("n", 15, Now)
    ThisWorkbook.Application.OnTime xCloseTime, "SaveWork1", Schedule:=True

    Else
    resetCount = resetCount + 1
    xCloseTime = DateAdd("n", 15, Now)
    ThisWorkbook.Application.OnTime xCloseTime, "SaveWork1", Schedule:=True
    End If
    End Sub
    ````
    This is using the same SaveWork1 As:

    ````
    Sub SaveWork1()
    Application.DisplayAlerts = False
    ThisWorkbook.Save
    ThisWorkbook.Close

    Application.DisplayAlerts = True
    End Sub

    ````
  • To post as a guest, your comment is unpublished.
    Joe · 1 years ago
    If you are working in a separate workbook at the point where close time is reached then it will close that workbook and not the inactive one. This can be solved by adjusting the code to: - corrected and tested from the below comment - use this code:

    Enter into "This Workbook"

    Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call TimeStop
    End Sub
    Private Sub Workbook_Open()
    Call TimeSetting
    End Sub
    Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Call TimeStop
    Call TimeSetting
    End Sub


    Enter into "module":

    Dim CloseTime As Date
    Sub TimeSetting()
    CloseTime = Now + TimeValue("00:10:00")
    On Error Resume Next
    Application.OnTime EarliestTime:=CloseTime, _
    Procedure:="SavedAndClose", Schedule:=True
    End Sub
    Sub TimeStop()
    On Error Resume Next
    Application.OnTime EarliestTime:=CloseTime, _
    Procedure:="SavedAndClose", Schedule:=False
    End Sub
    Sub SavedAndClose()
    ThisWorkbook.Close Savechanges:=True
    End Sub


    you can change the time setting by changing CloseTime = Now + TimeValue("00:10:00") - this is set to 10 minutes, change the("00:10:00") to whatever time you want and it works.
  • To post as a guest, your comment is unpublished.
    Rajesh rana · 2 years ago
    hi i want insert this code to an other code like expiration code with this code how i can do....?
    code is...following
    Private Sub Workbook_Open()

    Dim exdate As Date
    Dim i As Integer

    'modify values for expiration date here !!!
    anul = 2019 'year
    luna = 5 'month
    ziua = 16 'day

    exdate = DateSerial(anul, luna, ziua)

    If Date > exdate Then
    MsgBox ("The application " & ThisWorkbook.Name & " has expired !" & vbNewLine & vbNewLine _
    & "Expiration set up date is: " & exdate & " :)" & vbNewLine & vbNewLine _
    & "Contact Administrator to renew the version !"), vbCritical, ThisWorkbook.Name

    expired_file = ThisWorkbook.Path & "\" & ThisWorkbook.Name

    On Error GoTo ErrorHandler
    With Workbooks(ThisWorkbook.Name)
    If .Path <> "" Then

    .Saved = True
    .ChangeFileAccess xlReadOnly

    Kill expired_file

    'get the name of the addin if it is addin and unistall addin
    If Application.Version >= 12 Then
    i = 5
    Else: i = 4
    End If

    If Right(ThisWorkbook.Name, i) = ".xlam" Or Right(ThisWorkbook.Name, i) = ".xla" Then
    wbName = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - i)
    'uninstall addin if it is installed
    If AddIns(wbName).Installed Then
    AddIns(wbName).Installed = False
    End If
    End If

    .Close

    End If
    End With

    Exit Sub

    End If

    'MsgBox ("You have " & exdate - Date & "Days left")
    Exit Sub

    ErrorHandler:
    MsgBox "Fail to delete file.. "
    Exit Sub

    End Sub
  • To post as a guest, your comment is unpublished.
    seb · 2 years ago
    brilliant thanks
  • To post as a guest, your comment is unpublished.
    Torin · 2 years ago
    If you are working in a separate workbook at the point where close time is reached then it will close that workbook and not the inactive one. This can be solved by adjusting the code to:

    Dim CloseTime As Date
    Dim WKB As String
    Sub TimeSetting()
    WKB = ActiveWorkbook.Name
    CloseTime = Now + TimeValue("00:00:15")
    On Error Resume Next
    Application.OnTime EarliestTime:=CloseTime, _
    Procedure:="SavedAndClose", Schedule:=True
    End Sub
    Sub TimeStop()
    On Error Resume Next
    Application.OnTime EarliestTime:=CloseTime, _
    Procedure:="SavedAndClose", Schedule:=False
    End Sub
    Sub SavedAndClose()
    Workbooks(WKB).Close Savechanges:=True
    End Sub
    • To post as a guest, your comment is unpublished.
      Pulsater · 1 years ago
      I sometimes run into a "Running time Error" when open the workbook that has this code built into it. Anyway to write this code better for it to be more stable?
    • To post as a guest, your comment is unpublished.
      Ro · 2 years ago
      I noticed the same thing. And found the same solution :-)
  • To post as a guest, your comment is unpublished.
    Excel · 3 years ago
    The above code is not working when a cell is active. That is

    1. enter a value in the cell (don't press Enter or tab)

    2. minimize the excel.

    In this case the code is not working.