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
После написания данного кода будут сформированы макросы создания пользовательского контекстного меню (CreateCustomContextMenu) и его удаления (DeleteCustomContextMenu), а также макросы, привязанные к командам созданного меню и предназначенные для вызова соответствующих вкладок диалогового окна Формат ячеек.
После выполнения макроса CreateCustomContextMenu будет сформировано контекстное меню, изображенное на рис. 3.36.
Рис. 3.36. Пользовательское контекстное меню
Это меню будет вызываться при щелчке правой кнопкой мыши на любой ячейке диапазона A2:D5. С помощью его команд осуществляется быстрый переход к соответствующей вкладке окна форматирования активной ячейки.
Просмотр содержимого папки
В процессе работы может возникать необходимость просмотра содержимого той или иной папки (например, для поиска требуемого файла). Чтобы ускорить данный процесс и не запускать для этой цели Проводник, рекомендуется воспользоваться макросом, код которого приведен в листинге 3.97.
' Объявление API-функции для отображения стандартного окна _
просмотра папок
Declare Function SHBrowseForFolder Lib «shell32.dll» _
Alias «SHBrowseForFolderA» (lpBrowseInfo As BROWSEINFO) As
Long
' Объявление API-функции для преобразования данных, возвращаемых _
функцией SHBrowseForFolder, в строку
Declare Function SHGetPathFromIDList Lib «shell32.dll» _
Alias «SHGetPathFromIDListA» (ByVal pidl As Long, ByVal _
pszPath As String) As Long
' Структура используется функцией SHBrowseForFolder
Type BROWSEINFO
hwndOwner As Long ' Родительское окно (для диалога)
pidlRoot As Long ' Корневая папка для просмотра
strDisplayName As String
strTitle As String ' Заголовок окна
ulFlags As Long ' Флаги для окна
' Следующие три параметра в VBA не используются
lpfn As Long
lParam As Long
iImage As Long
End Type
Sub BrowseFolder()
Dim strPath As String ' Папка, список файлов которой выводится
Dim strFile As String
Dim intRow As Long ' Текущая строка таблицы
' Выбор папки
strPath = dhBrowseForFolder()
If strPath = "" Then Exit Sub
If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
' Оформление заголовка отчета
ActiveSheet.Cells.ClearContents
ActiveSheet.Cells(1, 1) = «Имя файла»