Bom dia galera esperta,
Meus amigos venho humildemente, solicitar a ajuda de vcs. Sou novato com VBA em excel, venho aprendendo aos pouquinhos de forma autodidata.
Busquei outro dia um código na net, para fazer backup de um determinado arquivo.
Encontrei este que parece ser muito bom, mas tentei usá-lo em minha pasta de trabalho, mas não deu certo, como a forma em que foi dada para aplica-lo.
O código é este
Private Sub Workbook_Open()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
On Error GoTo erros
'Retorna o caminho completo até o arquivo sendo utilizado + seu nome
este_arquivo = ActiveWorkbook.Path & "" & ActiveWorkbook.Name
'Divide o nome (provavelmente JonathanCP.xls) em JonathanCP e xls
nome_dividido = Split(ActiveWorkbook.Name, ".")
'Busca a ultima data de backup
ultimo_backup = Worksheets("backup_control").Cells(1, 2).Value
'Salva se ainda não existir nenhum backup ou caso não tenha sido salvo o backup do mês anterior
If ultimo_backup = "" Or Month(ultimo_backup) <> Month(DateSerial(Year(Date), Month(Date) - 1, Day(Date))) Then
'Novo nome do arquivo c:testeJonatanCP_abril_2009.xls por exemplo
novo_nome = "C:teste" & nome_dividido(0) & "_" & _
MonthName(Month(DateSerial(Year(Date), Month(Date) - 1, Day(Date)))) & "_" & _
Year(DateSerial(Year(Date), Month(Date) - 1, Day(Date))) & ".xls"
'Grava a data do ultimo backup
Worksheets("backup_control").Cells(1, 2).Value = DateSerial(Year(Date), Month(Date) - 1, Day(Date))
'Salva o Backup
ActiveWorkbook.SaveAs Filename:=novo_nome, _
FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
'Volta para o arquivo que estava sendo usado
ActiveWorkbook.SaveAs Filename:=este_arquivo, _
FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
End If
'Os Month sobre DateSerial é para garantir que não exista o mês 0 (Caso seja janeiro)
erros:
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
O problema é que já tenho um outro código Private Sub Workbook_Open(), trabalhando na THISWORKSBOOK, e aí dá erro dizendo que já existe este nome. Porém a minha intenção não é criar um backup automático ainda, e sim criar um macro em um botão para fazer esse procedimento de backup.
Gostaria de saber se há alguma forma de usar este código para fazer isso. no caso transformando em uma SUB em um módulo separado. Assim, eu poderei utilizar um botão manualmente para fazer esse backup o momento que eu preferir.
Amigos espero que vcs possam me ajudar. Valeu um abraço grande de seu amigo Bruno.
meu e-mail: [email protected] ( me desculpem se estou ferindo alguma regra do fórum colocando meu e-mail, mas ainda nem tive o tempo de ler o termo.)
Postado : 22/10/2015 9:33 am