Notifications
Clear all

Macro para criar backup

8 Posts
2 Usuários
0 Reactions
1,946 Visualizações
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

Bom dia pessoal,

Estou precisando de uma ajuda, não sei se é possivel criar uma macro para que toda vez que eu faça uma alteração na planilha e salve ela crie uma planilha de backup e sobrescreva e planilha de backup anterior?

Grato
Ado

 
Postado : 09/12/2012 8:39 am
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

Boa tarde!!

Isso deve lhe ajudar...
http://office.microsoft.com/pt-br/excel ... 42985.aspx
Veja também..
Fonte:
http://www.exceltip.com/show_tip/Files, ... l/474.html

Sub SaveWorkbookBackup()
Dim awb As Workbook, BackupFileName As String, i As Integer, OK As Boolean
    If TypeName(ActiveWorkbook) = "Nothing" Then Exit Sub
    Set awb = ActiveWorkbook
    If awb.Path = "" Then
        Application.Dialogs(xlDialogSaveAs).Show
    Else
        BackupFileName = awb.FullName
        i = 0
        While InStr(i + 1, BackupFileName, ".") > 0
            i = InStr(i + 1, BackupFileName, ".")
        Wend
        If i > 0 Then BackupFileName = Left(BackupFileName, i - 1)
        BackupFileName = BackupFileName & ".bak"
        OK = False
        On Error GoTo NotAbleToSave
        With awb
            Application.StatusBar = "Saving this workbook..."
            .Save
            Application.StatusBar = "Saving this workbook backup..."
            .SaveCopyAs BackupFileName
            OK = True
        End With
    End If
NotAbleToSave:
    Set awb = Nothing
    Application.StatusBar = False
    If Not OK Then
        MsgBox "Backup Copy Not Saved!", vbExclamation, ThisWorkbook.Name
    End If
End Sub

Att

 
Postado : 09/12/2012 9:00 am
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

Boa tarde,

Alexandrevba fiz os teste e funcionou, por segurança não teria como fazer esta macro rodar junto com o botão fechar e com o botão salvar, porque corre o risco da pessoa quando fazer alteração esquecer de rodar a macro e dai não vai ter o backup.

Grato
Ado

 
Postado : 09/12/2012 3:06 pm
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

Boa tarde!!

Não se esqueça de clicar na mãozinha

O exemplo abaixo, não tem diretamente nada a ver com o seu, porém é só adaptar com os eventos Antes de Fechar e Antes de Salvar

Private Sub Workbook_BeforeClose(Cancel As Boolean) 
    On Error Resume Next 
    Application.OnTime dTime, "AfterSaveMacro", , False 
    On Error Goto 0 
End Sub 

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) 
    Run "BeforeSaveMacro" 
    dTime = Time + ("00:00:10") 
    Application.OnTime dTime, "AfterSaveMacro" 
End Sub 
 
Postado : 09/12/2012 3:14 pm
(@cybertica)
Posts: 43
Trusted Member
 

Boas
Vi o teu código e está exelente, sou novato em vba e gostava da tua ajuda eu tenho o seguinte código

 Private Sub Workbook_BeforeClose(Cancel As Boolean)
    With Application
        .CommandBars("Cell").Reset
    End With
    Application.DisplayAlerts = False
    
    ThisWorkbook.Save
End Sub   

Agora gostava de saber como faço para que o Código BACKUP faça o backup antes ou durante eu estar a fechar a planilha

 
Postado : 11/12/2012 7:05 am
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

Bom dia!!

Olá, Cybertica, seria ideal abrir sua próprio tópico.

Afinal explique exatamente o que pretende...

Att

 
Postado : 11/12/2012 7:10 am
(@cybertica)
Posts: 43
Trusted Member
 

Bom dia

Obrigado mas já resolvi, agora só gostava que o Bak fosse parar no pasta em C:Bakup

 
Postado : 11/12/2012 7:15 am
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

Bom dia!!

Exemplo...

Private Sub workbook_beforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim sFile
    Dim location As String
    Application.EnableEvents = False
    location = "C:DesktopArquivos" 'Mude para o local desejado
    sFile = Replace(ThisWorkbook.Name, ".xls", " Backup ") & Format(Now, "yyyymmdd hh-mm-ss")
    ThisWorkbook.SaveCopyAs location & sFile & ".xls"
    Application.EnableEvents = True
End Sub
 
Postado : 11/12/2012 7:25 am