Снять огорничения пробного периуда в Excell

[Menny83]

Private Sub Workbook_Open()

If CDate(Now()) > activate_end Then
Ans = MsgBox
For Each sht In ThisWorkbook.Sheets
If sht.Name <> cs_opt Then sht.Visible = xlSheetVeryHidden
Next sht
End If

End Sub


Public Const activate_end As Date = "05.08.2023"

Public Const cs_opt As String = настройки
Public Const cs_plan As String = инструкция
Public Const clr_empty As Long = 16777215
Public Const clr_night As Long = 15986394
Public Const clr_main_total As Long = 13421823
Public Const clr_sub_total As Long = 14277081 '15261367
Public Const clr_main_header As Long = 13434879
Public Const clr_green As Long = 5880731
Public Const clr_mark_total As Long = 14857357

Public oOpt As Worksheet
Public oPl As Worksheet
Public day_name(1 To 7) As String
Public MonthNum As New Collection
Public MonthName As New Collection
Public isHoliday As New Collection
Public dt, dt1

[Menny83]

Public Sub CreatePlan_click()

With Sheets(cs_opt)

Application.ReferenceStyle = xlA1

i_beg = .Range("cl_tasks").Row + 1
i_end = .Range("A" & Rows.Count).End(xlUp).Row
s_caption = CStr(.Range("caption").Value)
s_month_beg = .Range("month_beg").Value: s_year_beg = .Range("year_beg").Value
s_month_end = .Range("month_end").Value: s_year_end = .Range("year_end").Value
b_find = False

If i_end >= i_beg And s_month_beg <> "" And s_month_end <> "" And s_year_beg <> "" And s_year_end <> "" Then

s_name = cs_plan & " " & Left(s_month_beg, 3) & " " & Right(s_year_beg, 2) & "-" & Left(s_month_end, 3) & " " & Right(s_year_end, 2)

On Error Resume Next
Ans = Sheets(s_name).Name
If Err.Number = 0 Then b_find = True
Err.Clear
On Error GoTo 0

Ans = vbYes
If b_find Then
Ans = MsgBox("В книге уже присутствует лист """ & s_name & """." & vbCrLf & "Удалить его перед построением нового?", vbQuestion + vbYesNo, "Сообщение")
If Ans = vbYes Then
Application.DisplayAlerts = False
Sheets(s_name).Delete
Application.DisplayAlerts = True
On Error GoTo 0
End If
End If

If Ans = vbYes Then
If CDate(Now()) < activate_end Then
click_count = Sheets(cs_opt).Range("AD1").Value
If ThisWorkbook.Sheets.Count <= 6 And click_count <= 6 Then '#dev 6
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
click_count = click_count + 1
Sheets(cs_opt).Range("AD13").Value = click_count
Call InitReferences
Call CreatePlan(s_name, i_beg, i_end, s_month_beg, s_month_end, s_year_beg, s_year_end, s_caption)
' ThisWorkbook.Save '#dev
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Else
Ans = MsgBox
End If
Else
For Each sht In ThisWorkbook.Sheets
sht.Protect Password:="timesheet123"
If sht.Name <> cs_opt Then sht.Visible = xlSheetVeryHidden
Next sht
ThisWorkbook.Save
Ans = MsgBox
End If
End If

Else
Ans = MsgBox("Заполните обязательные поля:" & vbCrLf & """список задач"",""период планирования"".", vbInformation + vbOKOnly, "Сообщение")
End If

End With
End Sub

[Menny83]

Прошу подсказать решение в данном макросе по снятию ограничения пробного периода

[Serge 007]

Обратитесь к разработчику данного кода