none
Macro para salvar cópia da original a cada 12hs RRS feed

  • Pergunta

  • Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    ActiveSheet.Calculate

         Application.OnTime Now() + TimeValue("00:00:10"), "Salvar"

    ChDir "C:\Users\meu computador\Documents\Pasta_Aperfeiçoamento Reg. Diario"

    Application.DisplayAlerts = False

        ActiveWorkbook.SaveAs Filename:= _

            "C:\Users\m\Documents\Aperfeiçoamento Reg. Diario\Registro Diário - Cópia2.xlsm" _

            , FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

          End

    End Sub

    Quero criar uma macro  em uma worksheet, que salva uma cópia da plan original em outra pasta com todas as macros a cada 12hs, Esta macro funcionou a cada 10segundo ela salva.

    O problema é que quando ela salva pela primeira vez abre direto a cópia, sendo que a original fecha automático, e eu quero que apenas salve uma cópia, permanecendo a original aberta.

    Desde ja agradeço pela sua Atenção.

    quarta-feira, 16 de janeiro de 2013 21:15

Respostas

  • Cole o código abaixo na classe EstaPasta_de_trabalho e adapte para suas necessidades:

    Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
        Dim ws As Worksheet
        Dim vPlan As Variant
        'On Error Resume Next
        'Insira o nome de todas as planilhas abaixo
        On Error Resume Next
        For Each vPlan In Array("Plan1", "Plan2", "Plan3", "Plan4")
            Set ws = Sheets(vPlan)
            If Err.Number > 0 Then
                MsgBox "Erro! Nem todas as planilhas existem!", vbCritical
                'Resto do código aqui
                Exit Sub
            End If
        Next vPlan
    End Sub


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    • Marcado como Resposta miguelinho70 sexta-feira, 25 de janeiro de 2013 10:49
    quinta-feira, 24 de janeiro de 2013 20:30
    Moderador
  • Num módulo comum, cole o código:

    Const sTempo As String = "12:00:00"
    
    Public Sub TimerDefinir()
        Application.OnTime EarliestTime:=Now + TimeValue(sTempo), Procedure:="TimerAtualizar"
    End Sub
    
    Public Sub TimerCancelar()
        Application.OnTime EarliestTime:=Now + TimeValue(sTempo), Procedure:="TimerAtualizar", Schedule:=False
    End Sub
    
    Public Sub TimerAtualizar()
        ThisWorkbook.SaveCopyAs ThisWorkbook.Path & "\Backup " & Format(Now, "yyyy-MM-dd hh-mm-ss")
        MsgBox "Backup de Pasta de Trabalho salvo!", vbInformation
        TimerDefinir
    End Sub

    Na classe EstaPasta_de_trabalho, cole o código:

    Private Sub Workbook_Open()
        TimerDefinir
    End Sub

    Logo, quando você abre a pasta de trabalho, automaticamente se define o evento de se salvar a pasta de trabalho de 12h em 12h. Se quiser cancelar esse evento, basta executar uma vez a rotina TimerCancelar.

    Note que se você ficar com a pasta de trabalho aberta por 10h, fechá-la, e reabri-la, terá que esperar não apenas as 2h horas restantes para completar 12h, mas sim 12h completas, uma vez que o cronômetro do objeto application é reiniciado. Desta forma, sugiro diminuir o intervalo de 12h para 1h, já que raramente uma pessoa passa 12h seguidas com umas pasta de trabalho aberta.


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    • Marcado como Resposta miguelinho70 sábado, 19 de janeiro de 2013 19:14
    sábado, 19 de janeiro de 2013 16:31
    Moderador
  • Ótimo deu certo, so diminuir o tempo como recomendado.

    Obrigado Benzadeus

    • Marcado como Resposta miguelinho70 terça-feira, 26 de fevereiro de 2013 00:31
    sábado, 19 de janeiro de 2013 19:16
  • Quebrei muito a cabeça mas Serviu Direitinho.

    Obrigado Felipe pelas respostas

    • Marcado como Resposta miguelinho70 terça-feira, 26 de fevereiro de 2013 00:31
    sexta-feira, 25 de janeiro de 2013 10:53

Todas as Respostas

  • "O problema é que quando ela salva pela primeira vez abre direto a cópia, sendo que a original fecha automático, e eu quero que apenas salve uma cópia, permanecendo a original aberta."

    Troque

    ActiveWorkbook.SaveAs

    por:

    ActiveWorkbook.SaveCopyAs

    e adapte seu código.


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    quarta-feira, 16 de janeiro de 2013 21:38
    Moderador
  • Amigo não conseguir.

    sera possivel vc postar uma macro que salva uma plan completa com as macros, na qual esta planilha principal esteja na area de trabalho, e com a macro de 12hs ela possa criar sempre uma planilha em outra pasta localizada em meus documentos como reserva.

    Agradeço muito pela resposta

    quinta-feira, 17 de janeiro de 2013 00:33
  • Num módulo comum, cole o código:

    Const sTempo As String = "12:00:00"
    
    Public Sub TimerDefinir()
        Application.OnTime EarliestTime:=Now + TimeValue(sTempo), Procedure:="TimerAtualizar"
    End Sub
    
    Public Sub TimerCancelar()
        Application.OnTime EarliestTime:=Now + TimeValue(sTempo), Procedure:="TimerAtualizar", Schedule:=False
    End Sub
    
    Public Sub TimerAtualizar()
        ThisWorkbook.SaveCopyAs ThisWorkbook.Path & "\Backup " & Format(Now, "yyyy-MM-dd hh-mm-ss")
        MsgBox "Backup de Pasta de Trabalho salvo!", vbInformation
        TimerDefinir
    End Sub

    Na classe EstaPasta_de_trabalho, cole o código:

    Private Sub Workbook_Open()
        TimerDefinir
    End Sub

    Logo, quando você abre a pasta de trabalho, automaticamente se define o evento de se salvar a pasta de trabalho de 12h em 12h. Se quiser cancelar esse evento, basta executar uma vez a rotina TimerCancelar.

    Note que se você ficar com a pasta de trabalho aberta por 10h, fechá-la, e reabri-la, terá que esperar não apenas as 2h horas restantes para completar 12h, mas sim 12h completas, uma vez que o cronômetro do objeto application é reiniciado. Desta forma, sugiro diminuir o intervalo de 12h para 1h, já que raramente uma pessoa passa 12h seguidas com umas pasta de trabalho aberta.


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    • Marcado como Resposta miguelinho70 sábado, 19 de janeiro de 2013 19:14
    sábado, 19 de janeiro de 2013 16:31
    Moderador
  • Ótimo deu certo, so diminuir o tempo como recomendado.

    Obrigado Benzadeus

    • Marcado como Resposta miguelinho70 terça-feira, 26 de fevereiro de 2013 00:31
    sábado, 19 de janeiro de 2013 19:16
  • Esta macro me ajudou muito para guarantir a recuperar minha plan. Fiz algumas modificações; de excluir sem alerta a anterior, para guarantir apenas uma, assim evita acumulo.

    A minha pergunta é?  Como interromper a PrivateSubWorkbook_Open(), em uma eventual exclusão de uma das abas? É possível?

    Alguma macro que detecta uma exclusão de abas, pode ser ate mesmo nas proprias abas.

    Tenho 13 abas, 13 user form, e os usuários são vários. Uma exclusão de uma das abas além de perde os dados de grande importância, também sou o responsável, vai me dar muito trabalho para fazer outra planilha.

    Agradeço ao Benzadeus por ter me ajudado ate aqui.

    Agradeço a todos pela atenção

    segunda-feira, 21 de janeiro de 2013 19:42
  • Cole o código abaixo na classe EstaPasta_de_trabalho e adapte para suas necessidades:

    Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
        Dim ws As Worksheet
        Dim vPlan As Variant
        'On Error Resume Next
        'Insira o nome de todas as planilhas abaixo
        On Error Resume Next
        For Each vPlan In Array("Plan1", "Plan2", "Plan3", "Plan4")
            Set ws = Sheets(vPlan)
            If Err.Number > 0 Then
                MsgBox "Erro! Nem todas as planilhas existem!", vbCritical
                'Resto do código aqui
                Exit Sub
            End If
        Next vPlan
    End Sub


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    • Marcado como Resposta miguelinho70 sexta-feira, 25 de janeiro de 2013 10:49
    quinta-feira, 24 de janeiro de 2013 20:30
    Moderador
  • Quebrei muito a cabeça mas Serviu Direitinho.

    Obrigado Felipe pelas respostas

    • Marcado como Resposta miguelinho70 terça-feira, 26 de fevereiro de 2013 00:31
    sexta-feira, 25 de janeiro de 2013 10:53