Скрыть листы по запросу

[viter.alex]

Сообщение от Maxx

Подскажите еще, плз, неучу, где находится эта самая автозакрузка, т.е. куда шаблон поместить или где к этому шаблону путь указать???

Я сказал про автозагрузку по аналогии с Word. В Excel это несколько иначе делается. Значит так, сохрани файл как «Надстройку Excel». Он по-умолчанию даст тебе для сохранения свою папку надстроек, из нее надстройки запускаются автоматически. После того, как сохранил, перезапусти Excel. Теперь заходишь в «Кнопка «Office»→Параметры Excel→Надстройки→Управление:Надстро ики Excel→Перейти.»
Увидишь такое:

Отметь свою надстройку и все.
Добавлено позже
Нет, не все. В коде нужно изменить ThisWorkbook на ActiveWorkbook

  '--------------------------
  'Разделитель
  '--------------------------
  sXML = sXML & _
    "<menuSeparator id=""MenuSep1"" title=""Листы в данном файле""/>" & vbCr
  For Each sSheet In ActiveWorkbook.Sheets
    i = i + 1
    sXML = sXML & _
        "<button id=""ID_Sheet_" & i & """ " & _
        "label=""" & sSheet.Name & """ " & _
        "onAction=" & """ShowThisSheet"" " & _
        "tag=""" & sSheet.Name & """ />" & vbCr
  Next sSheet

А чтобы видеть и диаграммы нужно изменить везде Worksheets на Sheets. И будет тебе счастье (по-немецки счастье — это «глюк»)

[Maxx]

Теперь СУПЕР!!!!!!!!!!!!!

[viter.alex]

Вот еще, для полного счастья.
Вложенные меню для листов и диаграмм. Замени одноименную процедуру

Sub MenuHideShow_GetContent(control As IRibbonControl, ByRef content)
  Dim sXML As String
  Dim sSheet As Object
  Dim i As Integer
  sXML = "<menu xmlns=""" & "http://schemas.microsoft.com/office/2006/01/customui" & """>" & vbCr
  '--------------------------
  'Кнопка «Обновить»
  '--------------------------
  sXML = sXML & _
    "<button id=""RefreshDynMenu"" " & _
    "label=""Обновить"" " & _
    "onAction=""RefreshDynMenu_OnAction"" " & _
    "imageMso=""RecurrenceEdit"" " & _
    "tag=" & """ID_MenuHideShow""/>" & vbCr
  '--------------------------
  'Кнопка «Показать все»
  '--------------------------
  sXML = sXML & _
        "<button id=""ID_ShowAll"" " & _
          "label=""Показать все"" " & _
          "onAction=""ID_ShowAll_onAction""/>" & vbCr
  '--------------------------
  'Кнопка «Скрыть все, кроме активного»
  '--------------------------
  sXML = sXML & _
        "<button id=""ID_HideAllButCurrent"" " & _
          "label=""Скрыть все, кроме активного"" " & _
          "onAction=""HideAllButCurrent""/>" & vbCr
  '--------------------------
  'Разделитель для листов
  '--------------------------
  sXML = sXML & _
    "<menuSeparator id=""MenuSep1"" title=""Листы и диаграммы""/>" & vbCr
  If ActiveWorkbook.Worksheets.Count <> 0 Then 'создаем меню для листов
    sXML = sXML & vbTab & _
            "<menu id=""ID_Sheets"" " & _
              "label=""Рабочие листы (" & ActiveWorkbook.Worksheets.Count & ")""> " & vbCr
    '--------------------------
    'Список листов
    '--------------------------
    For Each sSheet In ActiveWorkbook.Worksheets
      i = i + 1
      sXML = sXML & _
          "<button id=""ID_Sheet_" & i & """ " & _
          "label=""" & sSheet.Name & """ " & _
          "onAction=" & """ShowThisSheet"" " & _
          "tag=""" & sSheet.Name & """ />" & vbCr
    Next sSheet
    sXML = sXML & "</menu>" 'завершаем меню для листов
  End If
  If ActiveWorkbook.Charts.Count <> 0 Then 'создаем меню для диаграмм
    sXML = sXML & vbTab & _
            "<menu id=""ID_Charts"" " & _
              "label=""Диаграммы (" & ActiveWorkbook.Charts.Count & ")""> " & vbCr
    '--------------------------
    'Список диаграмм
    '--------------------------
    For Each sSheet In ActiveWorkbook.Charts
      i = i + 1
      sXML = sXML & _
          "<button id=""ID_Charts_" & i & """ " & _
          "label=""" & sSheet.Name & """ " & _
          "onAction=" & """ShowThisSheet"" " & _
          "tag=""" & sSheet.Name & """ />" & vbCr
    Next sSheet
    sXML = sXML & "</menu>" 'завершаем меню для диаграмм
  End If
  content = sXML & "</menu>"
End Sub

[Maxx]

Ну теперь вообще КРУТО!