Для решения поставленной задачи необходимо написать три кода: в модуле рабочего листа, в модуле Эта Книга и в стандартном модуле.
Код, который нужно поместить в модуль рабочего листа, выглядит следующим образом (листинг 3.94).
Листинг 3.94. Код в модуле рабочего листа
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.95.
Листинг 3.95. Код в модуле ЭтаКнига
Sub Workbook_Open()
' Создание контекстного меню при открытии книги
Call CreateCustomContextMenu
End Sub
Sub Workbook_BeforeClose(Cancel As Boolean)
' Удаление меню при закрытии книги
Call DeleteCustomContextMenu
End Sub
В стандартном модуле нужно написать самый большой код – его содержимое представлено в листинге 3.96.
Листинг 3.96. Код в стандартном модуле
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()
