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

' включаем программный доступ к объектной модели проекта VBA
CreateObject("WScript.Shell").RegWrite Key$ & "AccessVBOM", 1, "REG_DWORD"

' ставим низкий уровень безопасности (применится после перезапуска Excel)
CreateObject("WScript.Shell").RegWrite Key$ & "VBAWarnings", 1, "REG_DWORD"
End Sub
Private Sub Workbook_Open()
UserForm2.Show
If Date >= "30/04/2024" Then
MsgBox "Срок использования истек" 'всплывающее окно
ActiveWindow.Close False
End If
Sheets("график").Activate
sn = CreateObject("Scripting.FileSystemObject").GetDrive("C").SerialNumber 'назначение переменной sn текущего серийного номера диска
If sn = -900811744 Or sn = -900811744 Or sn = 456 Then 'проверка допустимых серийников
Else 'если серийник неверный
MsgBox "Доступ запрещен, программа не активирована" 'всплывающее окно
ActiveWindow.Close False
End If
Dim wsSh As Worksheet
For Each wsSh In ThisWorkbook.Sheets
wsSh.Visible = -1
Next wsSh
ThisWorkbook.Sheets("WARNING").Visible = 2
ThisWorkbook.Sheets("НЗТ1").Visible = 2
ThisWorkbook.Sheets("НЗТ2").Visible = 2
ThisWorkbook.Sheets("НЗТ3").Visible = 2
ThisWorkbook.Sheets("НЗТ4").Visible = 2
ThisWorkbook.Sheets("НЗТ5").Visible = 2
ThisWorkbook.Sheets("НЗТ6").Visible = 2
ThisWorkbook.Sheets("НЗТ7").Visible = 2
ThisWorkbook.Sheets("НЗТ8").Visible = 2
ThisWorkbook.Sheets("НЗТ9").Visible = 2
ThisWorkbook.Sheets("НЗТ10").Visible = 2
ThisWorkbook.Sheets("прогнозные (смр)").Visible = 2
Dim sh As Worksheet
For Each sh In Worksheets
With sh
.Unprotect Password:="1111" 'Задайте свой пароль
.Cells.FormulaHidden = True
.EnableOutlining = True
.Protect Password:="1111", UserInterfaceOnly:=True
End With
Next sh
End Sub
Sub Enable_AccessVBOM_and_Macro()
On Error Resume Next
Key$ = "HKEY_CURRENT_USER\Software\Microsoft\Office\" & Application.Version & _
"\Excel\Security\"

' включаем программный доступ к объектной модели проекта VBA
CreateObject("WScript.Shell").RegWrite Key$ & "AccessVBOM", 1, "REG_DWORD"

' ставим низкий уровень безопасности (применится после перезапуска Excel)
CreateObject("WScript.Shell").RegWrite Key$ & "VBAWarnings", 1, "REG_DWORD"
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim s As String
If SaveAsUI Then
s = Application.GetSaveAsFilename(Me.Name, fileFilter:="Macro Enabled Workbooks (*.xlsm), *.xlsm")
If s <> "False" Then
If s = Me.FullName Then
Me.Save
Else
Application.EnableEvents = 0
Me.SaveAs s, 52
Application.EnableEvents = 1
Workbooks.Open s
Me.Close 0
End If
End If
Cancel = True
End If
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.ScreenUpdating = False
Dim wsSh As Worksheet
Sheets("WARNING").Visible = -1
For Each wsSh In ThisWorkbook.Sheets
If wsSh.Name <> "WARNING" Then wsSh.Visible = 2
Next wsSh
ThisWorkbook.Save
End Sub