Public Sub Auto_Close()
	'çàïóñêàåò ìàêðîñ Backup_Active_Workbook ïðè âûõîäå èç ôàéëà
    Call Backup_Active_Workbook
End Sub

Sub Backup_Active_Workbook()
    'v1.1
    'òåïåðü ó÷èòûâàåò ôîðìàò ôàéëà èñõîäíèêà
    
    Dim x As String
    strPath = "c:\BackUps"     'ïàïêà äëÿ ñîõðàíåíèÿ ðåçåðâíîé êîïèè
    On Error Resume Next
    x = GetAttr(strPath) And 0
    
	'îïðåäåëßåì èìß è îáðåçàåì â ýòîì èìåíèå ôîðìàò ôàéëà
    strFileFull = ActiveWorkbook.Name
    strFile = Mid(strFileFull, 1, InStrRev(strFileFull, ".xl") - 1)
    
	'îïßòü îïðåäåëßåì èìß ôàéëà è âûðåçàåì èç íåãî òîëüêî ôîðìàò ôàéëà
    strFileFull = ActiveWorkbook.Name
    FileFormatMe = Mid(strFileFull, InStrRev(strFileFull, ".xl"))
    endMe = Mid(FileFormatMe, 2)
    If Err = 0 Then ' åñëè ïóòü ñóùåñòâóåò - ñîõðàíßåì êîïèþ êíèãè, äîáàâëßß äàòó-âðåìß
        strDate = Format(Now, "dd-mm-yy hh-mm")
        FileNameXls = strPath & "\" & strFile & " " & strDate & FileFormatMe
        ActiveWorkbook.SaveCopyAs FileName:=FileNameXls
    Else 'åñëè ïóòü íå ñóùåñòâóåò - âûâîäèì ñîîáùåíèå, òàêàß æå îøèáêà áóæåò â ñëó÷àå çàêðûòèß ÷èñòîé êíèãè
        MsgBox "ïàïêà " & strPath & " íåäîñòóïíà èëè íå ñóùåñòâóåò!", vbCritical
    End If
End Sub