[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

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

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

[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)
Список Б (условный) - все остальные листы, которые отображаются при переходе по ссылке из списка А и скрываются при возвращении на лист из списка А

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

Поможете?