ali.b
2014/07/22, 19:10
سلام و خسته نباشید
دوستان عزیز خیلی ها نیاز دارن که هر بار برای فایل اکسلشون تغییراتی میدن ی نسخه پشتبان گرفته بشه تا در صورت مشکل بتونن اخرین تغییرات رو پیدا کنن و یا فایل های قبلی رو هم داشته باشن
با این کد هر بار که تغییری در فایل اکسل میدین خودکار در مسیر مورد نظر ذخیره میکنه
Private Sub Workbook_Deactivate()
End Sub
Private Sub Workbook_Open()
Application.Caption = "Microsoft Excel AutoBackup"
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim MyFilePath$, Extension$
MyFilePath = MyPCpath("MyDocuments")
Extension = Left(ThisWorkbook.Name, Len _
(ThisWorkbook.Name) - 4) & " Backup"
On Error Resume Next '<< folder exists
MkDir MyFilePath & Extension '<< create folder
'save current version of this book in the folder
ActiveWorkbook.SaveCopyAs Filename:=MyFilePath & _
Extension & "\" & Extension & _
(Format(Now, " mmm d yyyy, hh.mm.ss AMPM")) & ".xls"
End Sub
Public Function MyPCpath$(Folder)
MyPCpath = CreateObject("WScript.Shell").SpecialFolders _
(Folder) & Application.PathSeparator
End Function
برای اجرای ایکد باید اونو تو thisworkbook ذخیره کنین
دوستان عزیز خیلی ها نیاز دارن که هر بار برای فایل اکسلشون تغییراتی میدن ی نسخه پشتبان گرفته بشه تا در صورت مشکل بتونن اخرین تغییرات رو پیدا کنن و یا فایل های قبلی رو هم داشته باشن
با این کد هر بار که تغییری در فایل اکسل میدین خودکار در مسیر مورد نظر ذخیره میکنه
Private Sub Workbook_Deactivate()
End Sub
Private Sub Workbook_Open()
Application.Caption = "Microsoft Excel AutoBackup"
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim MyFilePath$, Extension$
MyFilePath = MyPCpath("MyDocuments")
Extension = Left(ThisWorkbook.Name, Len _
(ThisWorkbook.Name) - 4) & " Backup"
On Error Resume Next '<< folder exists
MkDir MyFilePath & Extension '<< create folder
'save current version of this book in the folder
ActiveWorkbook.SaveCopyAs Filename:=MyFilePath & _
Extension & "\" & Extension & _
(Format(Now, " mmm d yyyy, hh.mm.ss AMPM")) & ".xls"
End Sub
Public Function MyPCpath$(Folder)
MyPCpath = CreateObject("WScript.Shell").SpecialFolders _
(Folder) & Application.PathSeparator
End Function
برای اجرای ایکد باید اونو تو thisworkbook ذخیره کنین