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

Компьютерный форум OSzone.net (http://forum.oszone.net/index.php)

- Microsoft Office (Word, Excel, Outlook и т.д.) (http://forum.oszone.net/forumdisplay.php?f=115)

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

Всем привет!

В книге 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

Видимо, надо загнать все отображаемые листы в переменную и сравнивать их по очереди, но не могу сообразить, как это сделать. Подскажете?
Спасибо!

Честно говоря, не очень понял суть, но по сравнению я бы высказался так — имеющийся код:

Код:

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

На выбор.

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

Этот вариант работает, если во всех именах отображаемых листов будет Main

Код:

If InStr(1, ws.Name, "Main", vbTextCompare) = 0 Then

Но в реальности имена этих листов будут разные, без общего паттерна.

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

Цитата:

Цитата Vadikan

Последовательное сравнение через 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

Цитата:

Цитата Vadikan

в реальности имена этих листов будут разные, без общего паттерна »

Чтобы каждый раз не вбивать имена листов в код, можно свести их через запятую в одну текстовую переменную (при условии, что в названиях листов не встречается запятая, иначе придется использовать другой разделитель!), и тогда использовать код ниже (имена листов нужно вбить в переменную 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

Полагаю, код можно облагородить и сделать поэлегантнее, если будет подобная необходимость.

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

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

Ещё мне не очень нравится то, что скрытые листы легко отображаются по команде меню (в моей версии \Формат\Лист\Отобразить…). Это явным образом противоречит:

Цитата:

Цитата Vadikan

Скрытые листы должны отображаться только при переходе по ссылке из первых трех. »

Рекомендую в релизе вместо «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.

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

Цитата:

Цитата Iska

Меня устраивает и в одном.

Цитата:

Цитата Iska

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

Условие "только" - не жесткое, возможность показать листы в меню даже удобна. В любом случае спасибо за разбор.

Меня тут другой вопрос заинтересовал. По поводу этого кода

Код:

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)

With Worksheets(Target.Range.Value)

    .Visible = True

    .Activate

    .Range("A1").Select

End With

End Sub

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

Цитата:

Цитата Vadikan

Можно как-то ограничить действие функции определенным столбцом, »

Имеется в виду столбец, в котором расположена сама гиперссылка? Как-то так:

Код:

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:// — то пропускать обработку.

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

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

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

Поможете?

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

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