'==================================================================================

Private Sub Workbook_BeforeClose(Cancel As Boolean)

If ActiveWorkbook.Name = ThisWorkbook.Name Then

FnShVisible2 False, "Как включить макросы", True

End If

End Sub

'==================================================================================

Private Sub Workbook_Open()

EventsChange False

If ActiveWorkbook.Name = ThisWorkbook.Name Then

FnShVisible2 True, "main", False

End If

EventsChange True

End Sub

'Sub tt()

'FnShVisible2 False, "Как включить макросы", True

'End Sub

'==================================================================================

'Как включить макросы

Function FnShVisible2(ByVal blnVal As Boolean, _

ByVal strShMain As String, _

ByVal blsSave As Boolean)

'strShMain - лист который оставляем выделенным

Dim iVisible As Integer

Dim strShName As String

With ThisWorkbook

.Sheets(strShMain).Visible = True 'сначала показать главный лист(чтобы не было ошибки если виден только один лист)

Set dDicListName = FnDicList()

For Each KeySh In dDicListName.keys

iVisible = dDicListName.Item(KeySh): If iVisible < 0 Then iVisible = iVisible * -1

strShName = KeySh

If iVisible <> 2 Then

If Not blnVal Then

Select Case iVisible

Case 0: iVisible = 1

Case 1: iVisible = 0

Case Else

End Select

End If

.Sheets(KeySh).Visible = iVisible

End If

Next 'KeySh

With .Sheets(strShMain)

.Visible = True

.Select

End With

If blsSave Then .Save

End With

End Function

'==================================================================================

Function FnDicList() As Object 'словарь видимости листов

Dim iVisible As Integer

Dim strShName As String

Set FnDic = CreateObject("Scripting.Dictionary")

With ThisWorkbook.Sheets("main")

iRowEnd = .Columns(1).Rows(65536).End(xlUp).Row

For i = 2 To iRowEnd

iVisible = .Cells(i, 3).Value

strShName = .Cells(i, 2).Value

If Len(.Cells(i, 2).Value) > 0 Then

If Not FnDic.exists(.Cells(i, 2).Value) Then FnDic.Add strShName, iVisible

End If

iVisible = 0

strShName = ""

Next i

End With

Set FnDicList = FnDic

End Function

'==================================================================================

'сформировать список листов(видимость)

Sub ShName()

With ThisWorkbook

With .Sheets("main")

iNbRowEnd = .Columns(1).Rows(Rows.Count).End(xlUp).Row

iNbCol = .Cells(1, Columns.Count).End(xlToLeft).Column

End With

For i = 1 To .Sheets.Count

.Sheets("main").Cells(i + 1, 1) = i

.Sheets("main").Cells(i + 1, 2) = .Sheets(i).Name

.Sheets("main").Cells(i + 1, 3) = .Sheets(i).Visible

Next i

If F_Save Then .Save

End With

End Sub