Note: The other languages of the website are Google-translated. Back to English

Jak uložit a zavřít sešit po nečinnosti po určitou dobu?

V některých případech můžete omylem zavřít sešit, když jste dlouhodobě zaneprázdněni jinými záležitostmi, které mohou ztratit některá důležitá data v sešitu. Existují nějaké triky, jak sešit automaticky uložit a zavřít, pokud jste jej po určitou dobu deaktivovali?

Automatické ukládání a zavírání sešitu po nečinnosti po určitou dobu pomocí VBA

šipka modrá pravá bublina Automatické ukládání a zavírání sešitu po nečinnosti po určitou dobu pomocí VBA

V aplikaci Excel neexistuje žádná vestavěná funkce, která by tento problém vyřešila, ale mohu představit kód makra, který vám pomůže uložit a zavřít sešit po nečinnosti v určitém čase.

1. Povolte sešit, který chcete automaticky uložit, po určité době nečinnosti zavřete a stiskněte Alt + F11 klíče k otevření Microsoft Visual Basic pro aplikace okno.

2. cvaknutí Vložit > Modul vytvořit Modul skript a vložte do něj pod kód. Viz 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 uložit zavřít sešit po nečinnosti 1

3. Pak v Průzkumník projektu v podokně poklepejte Tento sešita vložte následující kód do dalšího skriptu. Viz snímek obrazovky:

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 uložit zavřít sešit po nečinnosti 2

4. Přejděte na dvojité kliknutí na modul, který jste vložili v kroku 2, a stiskněte F5 klíč ke spuštění kódu. Viz snímek obrazovky:
doc uložit zavřít sešit po nečinnosti 3

5. Po 15 sekundách se zobrazí dialogové okno, které vám připomene uložení sešitu, a klikněte Ano uložit a zavřít sešit.
doc uložit zavřít sešit po nečinnosti 4

Tip:

(1) V prvním kódu můžete v tomto řetězci změnit čas nečinnosti na jiný: Nyní + TimeValue („00:00:15“)

(2) Pokud jste sešit ještě nikdy neuložili, Uložit jako nejprve vyjde dialogové okno a požádá vás o jeho uložení.
doc uložit zavřít sešit po nečinnosti 5


dobrý Chraňte pracovní list

Kutools pro Excel Chraňte pracovní list Tato funkce dokáže rychle chránit více listů nebo celý sešit najednou.
doc chrání více pracovních listů

Nejlepší kancelářské nástroje produktivity

Kutools pro Excel řeší většinu vašich problémů a zvyšuje vaši produktivitu o 80%

  • Opakované použití: Rychle vložte složité vzorce, grafy a cokoli, co jste dříve používali; Šifrovat buňky s heslem; Vytvořte seznam adresátů a posílat e-maily ...
  • Super Formula Bar (snadno upravit více řádků textu a vzorce); Rozložení pro čtení (snadno číst a upravovat velké množství buněk); Vložit do filtrovaného rozsahu...
  • Sloučit buňky / řádky / sloupce bez ztráty dat; Rozdělit obsah buněk; Zkombinujte duplicitní řádky / sloupce... Zabraňte duplicitním buňkám; Porovnat rozsahy...
  • Vyberte možnost Duplikovat nebo Jedinečný Řádky; Vyberte prázdné řádky (všechny buňky jsou prázdné); Super hledání a fuzzy hledání v mnoha sešitech; Náhodný výběr ...
  • Přesná kopie Více buněk beze změny odkazu na vzorec; Automaticky vytvářet reference do více listů; Vložte odrážky, Zaškrtávací políčka a další ...
  • Extrahujte text, Přidat text, Odebrat podle pozice, Odebrat mezeru; Vytváření a tisk mezisoučtů stránkování; Převod mezi obsahem buněk a komentáři...
  • Super filtr (uložit a použít schémata filtrů na jiné listy); Rozšířené řazení podle měsíce / týdne / dne, frekvence a dalších; Speciální filtr tučnou kurzívou ...
  • Kombinujte sešity a pracovní listy; Sloučit tabulky na základě klíčových sloupců; Rozdělte data do více listů; Dávkový převod xls, xlsx a PDF...
  • Více než 300 výkonných funkcí. Podporuje Office / Excel 2007-2021 a 365. Podporuje všechny jazyky. Snadné nasazení ve vašem podniku nebo organizaci. Plné funkce 30denní bezplatná zkušební verze. 60denní záruka vrácení peněz.
karta kte 201905

Office Tab přináší do Office rozhraní s kartami a usnadňuje vám práci

  • Povolte úpravy a čtení na kartách ve Wordu, Excelu, PowerPointu, Publisher, Access, Visio a Project.
  • Otevřete a vytvořte více dokumentů na nových kartách ve stejném okně, nikoli v nových oknech.
  • Zvyšuje vaši produktivitu o 50%a snižuje stovky kliknutí myší každý den!
officetab dno
Komentáře (11)
Zatím žádné hodnocení. Buďte první, kdo ohodnotí!
Tento komentář byl moderátorem webu minimalizován
Výše uvedený kód nefunguje, když je buňka aktivní. To znamená

1. zadejte hodnotu do buňky (netiskněte Enter ani tabulátor)

2. minimalizovat excel.

V tomto případě kód nefunguje.
Tento komentář byl moderátorem webu minimalizován
Pokud pracujete v samostatném sešitu v okamžiku dosažení času uzavření, zavře se tento sešit, nikoli neaktivní. To lze vyřešit úpravou kódu na:

Ztlumit CloseTime jako datum
Ztlumit WKB jako řetězec
Sub TimeSetting()
WKB = ActiveWorkbook.Name
CloseTime = Now + TimeValue("00:00:15")
On Error Resume Next
Application.OnTime EarliestTime:=CloseTime, _
Procedure:="SavedAndClose", Plán:=True
End Sub
Sub TimeStop()
On Error Resume Next
Application.OnTime EarliestTime:=CloseTime, _
Procedure:="SavedAndClose", Plán:=False
End Sub
Sub SavedAndClose()
Workbooks(WKB).Close Savechanges:=True
End Sub
Tento komentář byl moderátorem webu minimalizován
Všiml jsem si toho samého. A našel stejné řešení :-)
Tento komentář byl moderátorem webu minimalizován
Při otevření sešitu, ve kterém je tento kód zabudován, někdy narazím na „Chyba běhu“. Každopádně napsat tento kód lépe, aby byl stabilnější?
Tento komentář byl moderátorem webu minimalizován
brilantní díky
Tento komentář byl moderátorem webu minimalizován
ahoj chci vložit tento kód do jiného kódu, jako je kód vypršení platnosti s tímto kódem, jak mohu udělat....?
kód je...následující
Soukromá podřízená sešit_Open ()

Dim exdate As Date
Dim i As Integer

'upravte hodnoty pro datum vypršení platnosti zde !!!
anul = 2019 'rok
luna = 5 'měsíců
ziua = 16 'den

exdate = DateSerial(anul, luna, ziua)

If Date > exdate Then
MsgBox ("Platnost aplikace " & ThisWorkbook.Name & " vypršela !" & vbNewLine & vbNewLine _
& "Datum nastavení vypršení platnosti je: " & exdate & " :)" & vbNewLine & vbNewLine _
& "Pro obnovení verze kontaktujte administrátora!"), vbCritical, ThisWorkbook.Name

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

Při chybě GoTo ErrorHandler
Se sešity (ThisWorkbook.Name)
If .Path <> "" Pak

.Uloženo = Pravda
.ChangeFileAccess xlReadOnly

Zabít expirovaný_soubor

'Získejte název doplňku, pokud je to addin, a odinstalujte doplněk
Pokud Application.Version >= 12 Pak
i = 5
Jinak: 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)
'odinstalovat doplněk, pokud je nainstalován
Pokud AddIns(wbName).Installed Then
AddIns(wbName).Installed = False
End If
End If

.Zavřít

End If
Konec s

Konec Sub

End If

'MsgBox ("Máte " & exdate - Datum a "Zbývající dny")
Konec Sub

ErrorHandler:
MsgBox "Nelze odstranit soubor.."
Konec Sub

End Sub
Tento komentář byl moderátorem webu minimalizován
Pokud pracujete v samostatném sešitu v okamžiku dosažení času uzavření, zavře se tento sešit, nikoli neaktivní. To lze vyřešit úpravou kódu tak, aby: - ​​opraven a otestován z níže uvedeného komentáře - použijte tento kód:

Vstupte do "Tohoto sešitu"

Private Sub Workbook_BeforeClose (Zrušit jako Boolean)
Volejte TimeStop
End Sub
Soukromá podřízená sešit_Open ()
Nastavení doby hovoru
End Sub
Private Sub Workbook_SheetChange (ByVal Sh As Object, ByVal Target As Range)
Volejte TimeStop
Nastavení doby hovoru
End Sub


Vstupte do "modulu":

Ztlumit CloseTime jako datum
Sub TimeSetting()
CloseTime = Now + TimeValue("00:10:00")
On Error Resume Next
Application.OnTime EarliestTime:=CloseTime, _
Procedure:="SavedAndClose", Plán:=True
End Sub
Sub TimeStop()
On Error Resume Next
Application.OnTime EarliestTime:=CloseTime, _
Procedure:="SavedAndClose", Plán:=False
End Sub
Sub SavedAndClose()
ThisWorkbook.Close Savechanges:=True
End Sub


můžete změnit nastavení času změnou CloseTime = Now + TimeValue("00:10:00") - toto je nastaveno na 10 minut, změňte ("00:10:00") na libovolný čas a funguje to.
Tento komentář byl moderátorem webu minimalizován
Nejsem si jistý, co se stalo, ale toto řešení již nefunguje. Zde je oprava tohoto řešení, která pro mě fungovala:

````
Dim resetCount As Long

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

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

Sub Reset()On Error Resume Next
Statické xCloseTime
Pokud resetCount <> 0 Potom
ThisWorkbook.Application.OnTime xCloseTime, "SaveWork1", Schedule:=False
resetCount = resetCount + 1
xCloseTime = DateAdd("n", 15, Now)
ThisWorkbook.Application.OnTime xCloseTime, "SaveWork1", Plán:=True

Jiný
resetCount = resetCount + 1
xCloseTime = DateAdd("n", 15, Now)
ThisWorkbook.Application.OnTime xCloseTime, "SaveWork1", Plán:=True
End If
End Sub
````
Toto používá stejné SaveWork1 jako:
````Sub SaveWork1()
Application.DisplayAlerts = False
ThisWorkbook.Save
ThisWorkbook.Close

Application.DisplayAlerts = True
End Sub

````
Tento komentář byl moderátorem webu minimalizován
To je skvělé. Máte nějaké tipy na přidání vyskakovacího okna se zprávou, které uživatele upozorní, že se list blíží zavření, a dá mu možnost resetovat časovač?
Tento komentář byl moderátorem webu minimalizován
Když nechci upravovat a chci se jen poradit, soubor se stejně zavře. Nemělo by se zavírat. Měl bych restartovat počítání, když vyberu buňky. Co je řešení?
Tento komentář byl moderátorem webu minimalizován
Když nechci upravovat a chci se jen poradit, soubor se stejně zavře. Nemělo by se zavírat. Měl bych restartovat počítání, když vyberu buňky. Co je řešení?
Zatím zde nejsou žádné komentáře
Zanechat své připomínky
Odesílání jako host
×
Ohodnoťte tento příspěvek:
0   Postavy
Doporučená umístění

Sociální sítě

Copyright © 2009 - www.extendoffice.com. | Všechna práva vyhrazena. Poháněno ExtendOffice. | |. | Sitemap
Microsoft a logo Office jsou ochranné známky nebo registrované ochranné známky společnosti Microsoft Corporation ve Spojených státech a / nebo jiných zemích.
Chráněno Sectigo SSL