[решено] Excel - VBA - скрытие всех листов кроме перечисленных

[Vadikan]

Всем привет!

В книге Excel есть 3 листа, которые должны отображаться всегда, а также N листов, которые нужно скрывать. Скрытые листы должны отображаться только при переходе по ссылке из первых трех. Нагуглил такой код

Private Sub Worksheet_Activate()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If InStr(1, ws.Name, "Main", vbTextCompare) = 0 Then
ws.Visible = False
End If
Next ws
End Sub

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
With Worksheets(Target.Range.Value)
.Visible = True
.Activate
.Range("A1").Select
End With
End Sub


Первая часть кода скрывает листы, вторая - отображает их при переходе по ссылке, название которой совпадает с именем листа. Первое работает с одним листом Main, а у меня еще есть, скажем, Main1 и Main2.
If InStr(1, ws.Name, "Main", vbTextCompare) = 0 Then
Видимо, надо загнать все отображаемые листы в переменную и сравнивать их по очереди, но не могу сообразить, как это сделать. Подскажете?
Спасибо!

[Iska]

Честно говоря, не очень понял суть, но по сравнению я бы высказался так — имеющийся код:
If InStr(1, ws.Name, "Main", vbTextCompare) = 0 Then
ищет «Main» внутри имени очередного листа, а не делает точное сравнение со всей частью (как, например, в «If StrComp(ws.Name, "Main", vbTextCompare) = 0 Then»)


Можно делать последовательное сравнение:
If StrComp(ws.Name, "Main", vbTextCompare) = 0 Or StrComp(ws.Name, "Main1", vbTextCompare) = 0 Or StrComp(ws.Name, "Main2", vbTextCompare) = 0 Then
Можно (если имена именно такие, и нет, скажем, какого-нибудь «Main3», который надо скрывать) сравнивать начальную часть имени листа:
If StrComp(Left(ws.Name, Len("Main")), "Main", vbTextCompare) = 0 Then
Можно (с теми же оговорками) пробовать регулярку, наподобие:
Dim objRegExp As Variant

Set objRegExp = CreateObject("VBScript.RegExp")
objRegExp.Pattern = "^(?:Main|Main(?:1|2))$"
…
…
If objRegExp.Test(ws.Name) Then
На выбор.

[Vadikan]

Iska, мне неважно, будет он искать часть имени или все имя. Имена будут другие, их можно хардкодить.

Этот вариант работает, если во всех именах отображаемых листов будет Main
If InStr(1, ws.Name, "Main", vbTextCompare) = 0 Then
Но в реальности имена этих листов будут разные, без общего паттерна.

Последовательное сравнение через Or не работает, оно скрывает листы Main или вылетает с ошибкой. Прикрепляю файл, код в первом листе.

[a_axe]

Последовательное сравнение через Or не работает »
Vadikan, не хватает Not перед условиями, связанными Or, и взять сами условия в скобки (мы ищем случай, когда ни одно из имен не встречается):
If Not (StrComp(ws.Name, "Main1", vbTextCompare) = 0 Or StrComp(ws.Name, "Main2", vbTextCompare) = 0 Or StrComp(ws.Name, "Main3", vbTextCompare) = 0) Then
в реальности имена этих листов будут разные, без общего паттерна »
Чтобы каждый раз не вбивать имена листов в код, можно свести их через запятую в одну текстовую переменную (при условии, что в названиях листов не встречается запятая, иначе придется использовать другой разделитель!), и тогда использовать код ниже (имена листов нужно вбить в переменную strNames через запятые без пробелов):
Private Sub Worksheet_Activate()
Dim ws As Worksheet
Dim strNames As String
strNames = "Main1,Main2,Main3": ' Перечень листов через запятую, который можно менять
strNames = "," & strNames & ","
For Each ws In ThisWorkbook.Worksheets

If Not InStr(strNames, "," & ws.Name & ",") <> 0 Then
ws.Visible = False
End If
Next ws
End Sub
Полагаю, код можно облагородить и сделать поэлегантнее, если будет подобная необходимость.

[Vadikan]

a_axe, вот так я это и представлял, спасибо!
С условием not понял.

[Iska]

Как я понимаю, процедуру «Worksheet_Activate()» придётся поместить в модуль каждого рабочего листа, кроме скрытых «Screen1» («Screen2», «Screen3» и т.д.), и процедуру «Worksheet_FollowHyperlink()» — в модуль каждого листа с подобными гиперссылками. Мне это не очень нравится.

Ещё мне не очень нравится то, что скрытые листы легко отображаются по команде меню (в моей версии \Формат\Лист\Отобразить…). Это явным образом противоречит:
Скрытые листы должны отображаться только при переходе по ссылке из первых трех. »
Рекомендую в релизе вместо «WorkSheet.Visible = False» использовать «Worksheet.Visible = xlVeryHidden» — это уберёт возможность «ручного» отображения листов и оставит возможность только программного отображения.

Посему я предлагаю несколько иной код, размещённый только в одном модуле — «ThisWorkbook»:
Option Explicit

Private arrMainGroupWorksheets As Variant ' Массив для имён всегда отображаемых листов, заполняется в процедуре при открытии Рабочей книги

Private Sub Workbook_Open()
arrMainGroupWorksheets = Array("Main1", "Main2", "Main3") ' Задаём имена всегда отображаемых листов
End Sub

Private Sub Workbook_SheetActivate(ByVal objCurrWorksheet As Object)
Dim objWorksheet As Worksheet

If IsInMainGroupOfWorksheets(objCurrWorksheet) Then ' Если выделенный Рабочий лист входит в группу всегда отображаемых листов, то сейчас надо пройтись перебором по всем Рабочим листам и скрыть их все, кроме всегда отображаемых.
For Each objWorksheet In objCurrWorksheet.Parent.Worksheets ' …для каждого Рабочего листа Рабочей книги выделенного Рабочего листа…
If Not IsInMainGroupOfWorksheets(objWorksheet) Then ' Если очередной Рабочий лист не входит в группу всегда отображаемых листов, то…
objWorksheet.Visible = xlVeryHidden ' …скрываем его.
End If
Next
End If
End Sub

Private Sub Workbook_SheetFollowHyperlink(ByVal objWorksheet As Object, ByVal Target As Hyperlink)
With Worksheets.Item(Target.Range.Value)
.Visible = True
.Activate
.Range(Target.SubAddress).Select
End With
End Sub

Function IsInMainGroupOfWorksheets(objWorksheet As Worksheet) ' Проверяем, входит ли переданный Рабочий лист в группу всегда отображаемых листов
Dim strWorksheetName As Variant


IsInMainGroupOfWorksheets = False ' Предположим, что не входит

For Each strWorksheetName In arrMainGroupWorksheets ' Перебираем все имена из массива всегда отображаемых листов
If StrComp(objWorksheet.Name, strWorksheetName, vbTextCompare) = 0 Then ' Если имя переданного Рабочего листа совпало с каким-либо именем из массива, то…
IsInMainGroupOfWorksheets = True ' Утверждаем, что входит и…

Exit Function ' Выходим из функции
End If
Next
End Function

И сама Рабочая книга в архиве: 147892.

Разумеется, если я правильно понял потребности.

[Vadikan]

Как я понимаю, процедуру «Worksheet_Activate()» придётся поместить в модуль каждого рабочего листа, кроме скрытых «Screen1» («Screen2», «Screen3» и т.д.), и процедуру «Worksheet_FollowHyperlink()» — в модуль каждого листа с подобными гиперссылками. »
Меня устраивает и в одном.

скрытые листы легко отображаются по команде меню (в моей версии \Формат\Лист\Отобразить…). Это явным образом противоречит: »
Условие "только" - не жесткое, возможность показать листы в меню даже удобна. В любом случае спасибо за разбор.

Меня тут другой вопрос заинтересовал. По поводу этого кода
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
With Worksheets(Target.Range.Value)
.Visible = True
.Activate
.Range("A1").Select
End With
End Sub

В листе есть не только гиперссылки на скрытые листы, но и обычные веб-ссылки. При переходе по ним вылетает дебаггер, хотя ссылки открываются. Можно как-то ограничить действие функции определенным столбцом, например?

[Iska]

Можно как-то ограничить действие функции определенным столбцом, »
Имеется в виду столбец, в котором расположена сама гиперссылка? Как-то так:
If Target.Range.Column = 1 Then ' Если гиперссылка расположена в столбце «A», то…
With Worksheets(Target.Range.Value)
.Visible = True
.Activate
.Range("A1").Select
End With
End If

Можно также смотреть на адрес ссылки (Target.Address), и если он начинается с http:// — то пропускать обработку.

[Vadikan]

Iska, да, именно это, спасибо!

[Vadikan]

Возникла необходимость изменить функциональность скрипта (дублирую пост 4)

Private Sub Worksheet_Activate()
Dim ws As Worksheet
Dim strNames As String
strNames = "Main1,Main2,Main3": ' Перечень листов через запятую, который можно менять
strNames = "," & strNames & ","
For Each ws In ThisWorkbook.Worksheets

If Not InStr(strNames, "," & ws.Name & ",") <> 0 Then
ws.Visible = False
End If
Next ws
End Sub
Сейчас:
Список А - листы всегда отображаются (strNames)
Список Б (условный) - все остальные листы, которые отображаются при переходе по ссылке из списка А и скрываются при возвращении на лист из списка А

Вместо этого нужно не скрываются до закрытия книги. Другими словами, при открытии книги только список А, а во время работы с книгой список А и все листы из списка Б, которые были активированы при переходе из списка А.

Поможете?

[a_axe]

Vadikan, можно воспользоваться кодом ниже, благо коллега Iska обозначил оптимальные пути решения :).
Код нужно скопировать в модуль ThisWorkbook. Все листы рабочей книги, не входящие в список листов А, будут скрываться при каждом открытии файла.
Private Sub Workbook_Open()
Dim ws As Worksheet
Dim strNames As String
strNames = "Main1,Main2,Main3": ' Перечень листов через запятую, который можно менять
strNames = "," & strNames & ","
For Each ws In ThisWorkbook.Worksheets

If Not InStr(strNames, "," & ws.Name & ",") <> 0 Then
ws.Visible = xlVeryHidden
End If
Next ws

End Sub

Private Sub Workbook_SheetFollowHyperlink(ByVal Sh As Object, ByVal Target As Hyperlink)
With Worksheets.Item(Target.Range.Value)
.Visible = True
.Activate
.Range(Target.SubAddress).Select
End With
End Sub

[Vadikan]

Отлично, спасибо!