Note: The other languages of the website are Google-translated. Back to English
Iniciar Sessão Inscreve-te

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

Bom estado, com sinais de uso 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 ...
  • Barra Super Fórmula (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-2021 e 365. Suporta todos os idiomas. Fácil implantação em sua empresa ou organização. Recursos completos de avaliação gratuita de 30 dias. 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!
parte inferior da aba do escritório
Comentários (11)
Ainda não há classificações. Seja o primeiro a avaliar!
sobressair
sobressair
Este comentário foi feito pelo moderador no site
O código acima não está funcionando quando uma célula está ativa. Isso é

1. insira um valor na célula (não pressione Enter ou tab)

2. minimizar o excel.

Neste caso o código não está funcionando.
Resposta
0
0
Torin
Torin
Este comentário foi feito pelo moderador no site
Se você estiver trabalhando em uma pasta de trabalho separada no ponto em que o tempo de fechamento for atingido, ela fechará essa pasta de trabalho e não a inativa. Isso pode ser resolvido ajustando o código para:

Dim CloseTime as Date
Dim WKB como string
Sub TimeSetting()
WKB = ActiveWorkbook.Name
CloseTime = Now + TimeValue("00:00:15")
On Error Resume Next
Application.OnTime EarlyTime:=CloseTime, _
Procedimento:="SavedAndClose", Schedule:=True
End Sub
SubTimeStop()
On Error Resume Next
Application.OnTime EarlyTime:=CloseTime, _
Procedimento:="SavedAndClose", Agenda:=Falso
End Sub
Sub SalvoEFechar()
Pastas de trabalho(WKB).Fechar Savechanges:=True
End Sub
Resposta
0
0
Ro
Ro     Torin
Este comentário foi feito pelo moderador no site
Eu notei a mesma coisa. E encontrei a mesma solução :-)
Resposta
0
0
Pulsador
Pulsador     Torin
Este comentário foi feito pelo moderador no site
Às vezes, encontro um "Erro em tempo de execução" ao abrir a pasta de trabalho que contém esse código. De qualquer forma para escrever este código melhor para que ele fique mais estável?
Resposta
0
0
seb
seb
Este comentário foi feito pelo moderador no site
brilhante obrigado
Resposta
0
0
rajesh rana
rajesh rana
Este comentário foi feito pelo moderador no site
oi eu quero inserir este código para um outro código como código de expiração com este código como posso fazer ....?
o código é... a seguir
Private Sub Workbook_Open ()

Dim exdate como data
Dim i As Integer

'modifique os valores para data de expiração aqui !!!
anul = 2019 'ano
luna = 5 'mês
ziua = 16 'dia

exdate = DateSerial(anul, luna, ziua)

Se Data > exdate Então
MsgBox ("A aplicação " & ThisWorkbook.Name & " expirou !" & vbNewLine & vbNewLine _
& "A data de configuração de expiração é: " & exdate & " :)" & vbNewLine & vbNewLine _
& "Entre em contato com o administrador para renovar a versão!"), vbCritical, ThisWorkbook.Name

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

Em caso de erro Ir para ErrorHandler
Com pastas de trabalho(ThisWorkbook.Name)
If .Path <> "" Então

.Salvo = Verdadeiro
.ChangeFileAccess xlReadOnly

Matar arquivo_expirado

'pega o nome do addin se for addin e desinstala o addin
Se Application.Version >= 12 Then
i = 5
Caso contrário: i = 4
Se acabar

Se Right(ThisWorkbook.Name, i) = ".xlam" Ou Right(ThisWorkbook.Name, i) = ".xla" Then
wbName = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - i)
'desinstala o addin se estiver instalado
Se AddIns(wbName).Instalado Então
AddIns(wbName).Instalado = False
Se acabar
Se acabar

. Fechar

Se acabar
Terminar com

Exit Sub

Se acabar

'MsgBox ("Você tem " & exdate - Data e "Dias restantes")
Exit Sub

ErrorHandler:
MsgBox "Falha ao deletar arquivo.."
Exit Sub

End Sub
Resposta
0
0
Joe
Joe
Este comentário foi feito pelo moderador no site
Se você estiver trabalhando em uma pasta de trabalho separada no ponto em que o tempo de fechamento for atingido, ela fechará essa pasta de trabalho e não a inativa. Isso pode ser resolvido ajustando o código para: - corrigido e testado a partir do comentário abaixo - use este código:

Entre em "Esta pasta de trabalho"

Private Sub Workbook_BeforeClose(Cancelar como booleano)
Parada de tempo de chamada
End Sub
Private Sub Workbook_Open ()
Configuração do horário da chamada
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Parada de tempo de chamada
Configuração do horário da chamada
End Sub


Entre no "módulo":

Dim CloseTime as Date
Sub TimeSetting()
CloseTime = Now + TimeValue("00:10:00")
On Error Resume Next
Application.OnTime EarlyTime:=CloseTime, _
Procedimento:="SavedAndClose", Schedule:=True
End Sub
SubTimeStop()
On Error Resume Next
Application.OnTime EarlyTime:=CloseTime, _
Procedimento:="SavedAndClose", Agenda:=Falso
End Sub
Sub SalvoEFechar()
ThisWorkbook.Close Savechanges:=True
End Sub


você pode alterar a configuração de tempo alterando CloseTime = Now + TimeValue("00:10:00") - isso é definido para 10 minutos, altere o("00:10:00") para qualquer hora que você quiser e funciona.
Resposta
0
0
Xman
Xman
Este comentário foi feito pelo moderador no site
Não tenho certeza do que aconteceu, mas esta solução não funciona mais. Aqui está a correção para esta solução que funcionou para mim:

`` ``
Dim resetCount As Long

Sub pasta de trabalho pública_Open()
On Error Resume Next
Definir xWB = Esta pasta de trabalho
resetCont = 0
End Sub

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

Sub Reset() On Erro Continuar Próximo
Estático xCloseTime
Se resetCount <> 0 Then
ThisWorkbook.Application.OnTime xCloseTime, "SaveWork1", Schedule:=False
resetCount = resetCount + 1
xCloseTime = DateAdd("n", 15, Agora)
ThisWorkbook.Application.OnTime xCloseTime, "SaveWork1", Schedule:=True

Outro
resetCount = resetCount + 1
xCloseTime = DateAdd("n", 15, Agora)
ThisWorkbook.Application.OnTime xCloseTime, "SaveWork1", Schedule:=True
Se acabar
End Sub
`` ``
Isso está usando o mesmo SaveWork1 que:
````Sub SaveWork1()
Application.DisplayAlerts = False
Esta pasta de trabalho. Salvar
Esta pasta de trabalho. Fechar

Application.DisplayAlerts = Verdadeiro
End Sub

`` ``
Resposta
0
0
Jason
Jason
Este comentário foi feito pelo moderador no site
Isso é ótimo. Alguma dica sobre como adicionar uma caixa de mensagem pop-up que avisará o usuário que a planilha está prestes a ser fechada e fornecerá a opção de redefinir o cronômetro?
Resposta
0
0
Pedro Matos
Pedro Matos
Este comentário foi feito pelo moderador no site
Quando não quero editar e quero apenas consultar, o arquivo ainda fecha. Não deve fechar. Deve reiniciar a contagem quando seleciono as células. Qual é a solução?
Resposta
0
0
Pedro Matos
Pedro Matos
Este comentário foi feito pelo moderador no site
Quando não quero editar e quero apenas consultar, o arquivo ainda fecha. Não deve fechar. Deve reiniciar a contagem quando seleciono as células. Qual é a solução?
Resposta
Report
0
0
Não há comentários postados aqui ainda
Deixe o seu comentário
Locatário
Postando como convidado
Entrar
×
Avalie esta postagem:
Limpar
0   Personagens
Locais sugeridos

Siga-nos

Copyright © 2009 - www.extendoffice.com. | Todos os direitos reservados. Distribuído por ExtendOffice. | | | Mapa do site
Microsoft e o logotipo do Office são marcas comerciais ou marcas registradas da Microsoft Corporation nos Estados Unidos e / ou em outros países.
Protegido por Sectigo SSL