Нужно создать файл, который бы при закрытии создавал свою полную копию, за исключением участка кода который отвечает за дальнейшее копирование.
В папке "Пример", должна храниться обновляемая копия файла в одном экземпляре, с названием "Пример копия", которая при дальнейшем пользовании не должна плодить копии.
Вот как я попытался реализовать данное действие (во вложении пример файла):
Function ОткрытаЛиКнига(Имя) As Boolean
On Error Resume Next
With Workbooks(Имя): End With
ОткрытаЛиКнига = (Err = 0)
End Function
Private Sub Workbook_BeforeClose(Cancel As Boolean)
' Макрос Workbook_BeforeClose
Dim x As String
Dim strFileTitle As String
Dim strFileName As String
Dim strPath As String
strFileTitle = Left(ActiveWorkbook.Name, _
Len(ActiveWorkbook.Name) - 5) & " " & "копия" & ".xlsm"
strPath = "C:\Пример"
strFileName = strPath & "\" & strFileTitle
' Проверяем есть ли нужный нам файл в природе и не открыт ли уже, если открыт сохраняем закрываем
If ОткрытаЛиКнига(strFileTitle) Then
' Если открыта
Application.ScreenUpdating = False
Windows(strFileTitle).Activate
ActiveWorkbook.Save
Windows(strFileTitle).Close
Kill strFileName
Else
' Если не открыта
If Dir(strFileName) <> "" Then
Application.ScreenUpdating = False
Kill strFileName
Else
On Error Resume Next
x = GetAttr(strPath) And 0
If Err = 0 Then
' Если путь существует - сохраняем копию книги
ActiveWorkbook.SaveCopyAs Filename:=strFileName
Else
'Если путь не существует - выводим сообщение
MsgBox "Папка " & strPath & " недоступна или не существует!", vbCritical
End If
'___________________________________________________________________________
Application.ScreenUpdating = False
ActiveWorkbook.Open Filename:=strFileName
Windows(strFileTitle).Activate
With ActiveWorkbook.VBProject.VBComponents("ЭтаКнига").CodeModule
.DeleteLines 1, .CountOfLines
End With
ActiveWorkbook.Save
ActiveWorkbook.Close
Exit Sub
'___________________________________________________________________________
End If
End If
End Sub
