Sub Enable_AccessVBOM_and_Macro()
On Error Resume Next
Key$ = "HKEY_CURRENT_USER\Software\Microsoft\Office\" & Application.Version & _
"\Excel\Security\"

CreateObject("WScript.Shell").RegWrite Key$ & "AccessVBOM", 1, "REG_DWORD"

CreateObject("WScript.Shell").RegWrite Key$ & "VBAWarnings", 1, "REG_DWORD"
End Sub

Private Sub Workbook_NewSheet(ByVal Sh As Object)
Application.DisplayAlerts = False
MsgBox "К сожалению, Вы не можете добавить больше листов в эту книгу", vbInformation
Sh.Delete
Application.DisplayAlerts = True
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
ThisWorkbook.Close savechanges:=False
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If Not SaveAsUI Then Exit Sub
MsgBox "К сожалению, Вы не можете сохранить эту книгу на этом комьютере."
Cancel = True
End Sub

'Private Sub Workbook_BeforeClose(Cancel As Boolean)
'If Date <= #10/9/2018# Then Exit Sub
'With ThisWorkbook
' .Saved = False
' .ChangeFileAccess xlReadOnly
' On Error Resume Next
' SetAttr .FullName, 0
' Kill .FullName
' .Close False
'End With
'End Sub