Note: The other languages of the website are Google-translated. Back to English
Log in  \/ 
x
or
x
Inscreva-se  \/ 
x

or

Como salvar e fechar a pasta de trabalho após inatividade por um determinado período de tempo?

Às vezes, você pode fechar acidentalmente uma pasta de trabalho quando estiver ocupado com outros assuntos por muito tempo, o que pode causar a perda de alguns dados importantes da pasta de trabalho. Existe algum truque para salvar e fechar automaticamente a pasta de trabalho se você a tiver inativado por um determinado período de tempo?

Salvar e fechar a pasta de trabalho automaticamente após inatividade por um determinado período de tempo com o VBA

seta azul bolha direita Salvar e fechar a pasta de trabalho automaticamente após inatividade por um determinado período de tempo com o VBA

Não há nenhuma função embutida no Excel para resolver esse problema, mas posso apresentar um código de macro que pode ajudá-lo a salvar e fechar a pasta de trabalho após inatividade em um determinado tempo.

1. Habilite a pasta de trabalho que deseja salvar automaticamente e fechar após inatividade por alguns segundos e pressione Alt + F11 chaves para abrir Microsoft Visual Basic para Aplicações janela.

2. Clique inserção > Módulo para criar um Módulo script e cole o código abaixo nele. Veja a imagem:

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 salvar fechar pasta de trabalho após inatividade 1

3. Em seguida, no Explorador de Projetos painel, clique duas vezes Esta apostilae cole o código abaixo no script ao lado. Veja a imagem:

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 salvar fechar pasta de trabalho após inatividade 2

4. Clique duas vezes no módulo que você inseriu na etapa 2 e pressione F5 chave para executar o código. Veja a imagem:
doc salvar fechar pasta de trabalho após inatividade 3

5. Depois de 15 segundos, há uma caixa de diálogo que aparece para lembrá-lo de salvar a pasta de trabalho e clique em Sim para salvar e fechar a pasta de trabalho.
doc salvar fechar pasta de trabalho após inatividade 4

Dicas:

(1) No primeiro código, você pode alterar o tempo de inatividade para outro nesta string: Agora + TimeValue ("00:00:15")

(2) Se você nunca salvou a pasta de trabalho antes, o Salvar como A caixa de diálogo aparecerá primeiro e pedirá para você salvá-la.
doc salvar fechar pasta de trabalho após inatividade 5

Perfeito Proteger planilha
Kutools para Excel's Proteger planilha A função pode proteger rapidamente várias planilhas ou toda a pasta de trabalho de uma vez.
Vá para o download
Teste grátis 60 diasComprar
PayPal / MyCommerce
doc proteger várias planilhas

As melhores ferramentas de produtividade para escritório

O Kutools for Excel resolve a maioria dos seus problemas e aumenta sua produtividade em 80%

  • armadilha para peixes: Insira rapidamente fórmulas complexas, gráficos e qualquer coisa que você tenha usado antes; Criptografar células com senha; Criar lista de discussão e enviar emails ...
  • Super Formula Bar (edite facilmente várias linhas de texto e fórmula); Layout de leitura (ler e editar facilmente um grande número de células); Colar na faixa filtrada...
  • Mesclar células / linhas / colunas sem perder dados; Dividir o conteúdo das células; Combinar linhas / colunas duplicadas... Evite células duplicadas; Comparar intervalos...
  • Selecione Duplicado ou Único Linhas; Selecione linhas em branco (todas as células estão vazias); Super Find e Fuzzy Find em muitos livros; Seleção aleatória ...
  • Cópia exata Várias células sem alterar a referência da fórmula; Criação automática de referências para várias folhas; Inserir marcadores, Caixas de seleção e mais ...
  • Extrair Texto, Adicionar texto, remover por posição, Remover Espaço; Criar e imprimir subtotais de paginação; Converter entre conteúdo de células e comentários...
  • Super Filtro (salvar e aplicar esquemas de filtro a outras planilhas); Classificação Avançada por mês / semana / dia, frequência e mais; Filtro Especial por negrito, itálico ...
  • Combine pastas de trabalho e planilhas; Mesclar tabelas com base em colunas-chave; Divida os dados em várias folhas; Conversão em lote de xls, xlsx e PDF...
  • Mais de 300 recursos poderosos. Suporta Office / Excel 2007-2019 e 365. Suporta todos os idiomas. Fácil implantação em sua empresa ou organização. Teste gratuito de 30 dias com recursos completos. Garantia de devolução do dinheiro em 60 dias.
guia kte 201905

Guia do Office traz interface com guias para o Office e torna seu trabalho muito mais fácil

  • Habilite a edição e leitura com guias em Word, Excel, PowerPoint, Publisher, Access, Visio e Project.
  • Abra e crie vários documentos em novas guias da mesma janela, em vez de em novas janelas.
  • Aumenta sua produtividade em 50% e reduz centenas de cliques do mouse para você todos os dias!
officetab bottom
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.