Создание контекстного меню

Листинг 3.97. Код в модуле рабочего листа

Sub Worksheet_BeforeRightClick(ByVal Target As Excel.Range, _

Cancel As Boolean)

' Проверка, попадает ли выделенная ячейка в диапазон

If Union(Target.Range(" A1"), Range(" A2: D5")).Address = _

Range(" A2: D5").Address Then

' Показываем свое контекстное меню

CommandBars(" MyContextMenu").ShowPopup

Cancel = True

End If

End Sub

Листинг 3.98. Код в модуле ЭтаКнига

Sub Workbook_Open()

' Создание контекстного меню при открытии книги

Call CreateCustomContextMenu

End Sub

Sub Workbook_BeforeClose(Cancel As Boolean)

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

Call DeleteCustomContextMenu

End Sub

Листинг 3.99. Код в стандартном модуле

Sub CreateCustomContextMenu()

' Удаление одноименного меню

Call DeleteCustomContextMenu

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

With CommandBars.Add(" MyContextMenu", msoBarPopup,, True).Controls

' Создание и настройка кнопок меню

' Кнопка " Числовой формат"

With.Add(msoControlButton)

.Caption = " & Числовой формат..."

.OnAction = " ShowFormatNumber"

.FaceId = 1554

End With

' Кнопка " Выравнивание"

With.Add(msoControlButton)

.Caption = " & Выравнивание..."

.OnAction = " ShowFormatAlignment"

.FaceId = 217

End With

' Кнопка " Шрифт"

With.Add(msoControlButton)

.Caption = " & Шрифт..."

.OnAction = " ShowFormatFont"

.FaceId = 291

End With

' Кнопка " Границы"

With.Add(msoControlButton)

.Caption = " & Границы..."

.OnAction = " ShowFormatBorder"

.FaceId = 149

.BeginGroup = True

End With

' Кнопка " Узор"

With.Add(msoControlButton)

.Caption = " & Узор..."

.OnAction = " ShowFormatPatterns"

.FaceId = 1550

End With

' Кнопка " Защита"

With.Add(msoControlButton)

.Caption = " & Защита..."

.OnAction = " ShowFormatProtection"

.FaceId = 2654

End With

End With

End Sub

Sub DeleteCustomContextMenu()

' Удаление меню

On Error Resume Next

CommandBars(" MyContextMenu").Delete

End Sub

Sub ShowFormatNumber()

' Число

Application.Dialogs(xlDialogFormatNumber).Show

End Sub

Sub ShowFormatAlignment()

' Выравнивание

Application.Dialogs(xlDialogAlignment).Show

End Sub

Sub ShowFormatFont()

' Шрифт

Application.Dialogs(xlDialogFormatFont).Show

End Sub

Sub ShowFormatBorder()

' Граница

Application.Dialogs(xlDialogBorder).Show

End Sub

Sub ShowFormatPatterns()

' Вид (Узор)

Application.Dialogs(xlDialogPatterns).Show

End Sub

Sub ShowFormatProtection()

' Защита

Application.Dialogs(xlDialogCellProtection).Show

End Sub