Вызов предварительного просмотра

Sub Test()

With Application.Workbooks.Item("Test.xls")

Sheets("Test").PrintPreview

End With

End Sub

Создание пользовательского меню (вариант 1)

Sub AddCustomMenu()

' Добавление меню

With Application.CommandBars(1).Controls.Add(Type:=msoControlPopup, _

Temporary:=True)

.Caption = "Архив"

With .Controls

' Добавление и настройка первого пункта

With .Add(Type:=msoControlButton)

.FaceId = 280

.Caption = "Просмотр"

.OnAction = "Макрос1"

End With

' Добавление вложенного меню

With .Add(Type:=msoControlPopup)

.Caption = "База данных"

With .Controls

' Добавление и настройка первого пункта _

вложенного меню

With .Add(Type:=msoControlButton)

.FaceId = 1643

.Caption = "Поставщики"

.OnAction = "Макрос2"

End With

' Добавление и настройка второго пункта _

вложенного меню

With .Add(Type:=msoControlButton)

.FaceId = 1000

.Caption = "Покупатели"

.OnAction = "Макрос3"

End With

End With

End With

End With

End With

End Sub

Создание пользовательского меню (вариант 2)

Sub AddCustomMenu1()

' Добавление меню с названием "Архив" в часть меню, _

относящуюся к рабочей книге

With MenuBars("Worksheet").Menus.Add(Caption:="Архив")

' Добавление кнопки

.MenuItems.Add Caption:="Просмотр", OnAction:="Макрос1"

' Добавление подменю

With .MenuItems.AddMenu(Caption:="База данных")

' Добавление пунктов подменю

.MenuItems.Add Caption:="Поставщики", OnAction:="Макрос2"

.MenuItems.Add Caption:="Покупатели", OnAction:="Макрос3"

End With

End With

End Sub

Создание пользовательского меню (вариант 3)

Sub AddCustomMenu2()

' Добавление меню с названием "Архив" в часть меню, _

относящуюся к рабочей книге

With MenuBars("Worksheet").Menus.Add(Caption:="Архив")

' Добавление кнопки

.MenuItems.Add Caption:="Просмотр", OnAction:="Макрос1"

' Добавление подменю

With .MenuItems.AddMenu(Caption:="База данных")

' Добавление первого пункта подменю

With .MenuItems.Add(Caption:="Поставщики")

' Настройка кнопки

.OnAction = "Макрос2"

End With

' Добавление второго пункта подменю

With .MenuItems.Add(Caption:="Покупатели")

' Настройка кнопки

.OnAction = "Макрос3"

End With

End With

End With

End Sub

Создание пользовательского меню (вариант 4)

Sub Workbook_Open()

' Задание имени меню

strMenuName = "MyCommandBarName"

' Создание меню

CreateCustomMenu

End Sub

Создание пользовательского меню (вариант 5)

Sub Workbook_BeforeClose(Cancel As Boolean)

' Удаление меню перед закрытием книги

DeleteCustomMenu

End Sub

Public strMenuName As String ' Имя строки меню

Private cbrcBar As CommandBarControl

Sub CreateCustomMenu()

Dim cbrMenu As CommandBar

Dim cbrcMenu As CommandBarControl ' Выпадающее меню "Меню"

Dim cbrcSubMenu As CommandBarControl ' Выпадающее меню "Дополнительно"

' Если уже есть пользовательское меню, то оно удаляется

DeleteCustomMenu

' Создание меню вместо стандартного

Set cbrMenu = Application.CommandBars.Add(strMenuName, msoBarTop, _

True, True)

' Создание выпадающего меню с названием "Меню"

Set cbrcMenu = cbrMenu.Controls.Add(msoControlPopup, , , , True)

With cbrcMenu

.Caption = "&Меню"

End With

' Создание пункта меню

With cbrcMenu.Controls.Add(Type:=msoControlButton, _

Temporary:=True)

.Caption = "&Меню1"

.OnAction = "CallMenu1"

End With

' Создание пункта меню

With cbrcMenu.Controls.Add(Type:=msoControlButton, _

Temporary:=True)

.Caption = "Меню2"

.OnAction = "CallMenu2"

End With

' Создание подменю первого уровня

Set cbrcSubMenu = cbrcMenu.Controls.Add(Type:=msoControlPopup, _

Temporary:=True)

With cbrcSubMenu

.Caption = "Подменю1"

.BeginGroup = True

End With

' Создание пункта меню

With cbrcMenu.Controls.Add(Type:=msoControlButton, _

Temporary:=True)

.Caption = "Вкл/Выкл"

.OnAction = "MenuOnOff"

.Style = msoButtonIconAndCaption

.FaceId = 463

End With

' Создание пункта меню в подменю первого уровня

With cbrcSubMenu.Controls.Add(Type:=msoControlButton, _

Temporary:=True)

.Caption = "Подменю1"

.OnAction = "CallSubMenu1"

.Style = msoButtonIconAndCaption

.FaceId = 2950

.State = msoButtonDown

End With

' Cоздание пункта меню в подменю первого уровня (его состояние _

изменяется посредством пункта "Вкл/Выкл"), для чего сохраним ссылку _

на созданный пункт меню

Set cbrcBar = cbrcSubMenu.Controls.Add(Type:=msoControlButton, _

Temporary:=True)

With cbrcBar

.Caption = "Подменю2"

.OnAction = "CallSubMenu2"

' Сначала меню деактивировано

.Enabled = False

End With

' Создание подменю второго уровня

Set cbrcSubMenu = cbrcSubMenu.Controls.Add(Type:=msoControlPopup, _

Temporary:=True)

With cbrcSubMenu

.Caption = "ПодчПодменю1"

.BeginGroup = True

End With

' Cоздание пункта меню в подменю второго уровня

With cbrcSubMenu.Controls.Add(Type:=msoControlButton, _

Temporary:=True)

.Caption = "ПослМеню1"

.OnAction = "CallLastMenu1"

.Style = msoButtonIconAndCaption

.FaceId = 71

.State = msoButtonDown

End With

' Cоздание пункта меню в подменю второго уровня

With cbrcSubMenu.Controls.Add(Type:=msoControlButton, _

Temporary:=True)

.Caption = "ПослМеню2"

.OnAction = "CallLastMenu2"

.Style = msoButtonIconAndCaption

.FaceId = 72

.Enabled = True

End With

' Отображение меню

cbrMenu.Visible = True

Set cbrcSubMenu = Nothing

Set cbrcMenu = Nothing

Set cbrMenu = Nothing

End Sub

Sub DeleteCustomMenu()

' Удаление строки меню

On Error Resume Next

Application.CommandBars(strMenuName).Delete

On Error GoTo 0

End Sub

Sub CallMenu1()

' Обработка вызова Меню1

MsgBox "Приветствует меню 1!", vbInformation, ThisWorkbook.Name

End Sub

Sub CallMenu2()

' Обработка вызова Меню2

MsgBox "Приветствует меню 2!", vbInformation, ThisWorkbook.Name

End Sub

Sub CallSubMenu1()

' Обработка вызова Подменю1

MsgBox "Приветствует подменю 1!", vbInformation, ThisWorkbook.Name

End Sub

Sub CallSubMenu2()

' Обработка вызова Подменю2

MsgBox "Приветствует подменю 2!", vbInformation, ThisWorkbook.Name

End Sub

Sub CallLastMenu1()

' Обработка вызова Последнего меню1

MsgBox "Приветствует последнее меню 1!", vbInformation, ThisWorkbook.Name

End Sub

Sub CallLastMenu2()

' Обработка вызова Последнего меню2

MsgBox "Приветствует последнее меню 2!", vbInformation, ThisWorkbook.Name

End Sub

Sub MenuOnOff()

' Активация или деактивация пункта "Меню-Подменю1-Подменю2"

cbrcBar.Enabled = Not cbrcBar.Enabled

End Sub