Рис. 3.30. Результат выбора пункта Меню1
Чтобы вернуться в первоначальное состояние, необходимо воспользоваться макросом DeleteCustomMenu (в некоторых случаях для «отката» нужно закрыть рабочую книгу, затем вновь открыть ее и лишь после этого запустить макрос DeleteCustomMenu). Однако проще сделать по-другому: нужно щелкнуть правой кнопкой мыши на созданном меню и в открывшемся контекстном меню выполнить команду Удалить настраиваемую панель инструментов, после чего подтвердить удаление.
Меню со стандартными командами
В данном подразделе мы создадим пользовательское меню, которое будет включать в себя меню Файл (это меню будет соответствовать стандартному меню Файл из Excel более ранних версий) и меню Дополнительно.
Для реализации поставленной задачи необходимо в стандартном модуле редактора VBA написать код, представленный в листинге 3.81.
Листинг 3.81. Создание пользовательского меню
Sub CreateMenu()
Dim cbrMenu As CommandBar
Dim cbrcNewMenu As CommandBarControl
' Удаление меню, если оно уже есть
Call DeleteMenu
' Добавление строки пользовательского меню
Set cbrMenu = CommandBars.Add(MenuBar:=True)
With cbrMenu
.Name = «Моя строка меню»
.Visible = True
End With
' Копирование стандартного меню «Файл»
CommandBars(«Worksheet Menu Bar»).FindControl(ID:=30002).Copy _
CommandBars(«Моя строка меню»)
' Добавление нового меню – «Дополнительно»
Set cbrcNewMenu = cbrMenu.Controls.Add(msoControlPopup)
cbrcNewMenu.Caption = «&Дополнительно»
' Добавление команды в новое меню
With cbrcNewMenu.Controls.Add(msoControlButton)
.Caption = «&Восстановить обычную строку меню»
.OnAction = «DeleteMenu»
End With
' Добавление команды в новое меню
With cbrcNewMenu.Controls.Add(Type:=msoControlButton)
.Caption = «&Справка»
End With
End Sub
Sub DeleteMenu()
' Пытаемся удалить меню (успешно, если оно ранее создано)
On Error Resume Next
CommandBars(«Моя строка меню»).Delete
On Error GoTo 0
End Sub
В результате написания данного кода будет создан макрос CreateMenu. При его выполнении на вкладке Надстройки появится пользовательское меню, включающее в себя пункты Файл (этот пункт будет соответствовать стандартному меню Файл из Excel более ранниз версий) и Дополнительно. С помощью команды Дополнительно → Восстановить обычную строку меню созданное меню будет удалено. Команда Дополнительно → Справка имеет чисто демонстрационную функцию.
Склонение фамилии, имени и отчества
Трюк, который мы рассмотрим в данном разделе, удобно применять при работе со списками ФИО. С его помощью можно быстро переводить требуемые ФИО в родительный или дательный падеж. Чтобы достичь подобного эффекта, следует воспользоваться макросом, код которого приведен в листинге 3.82 (данный код записывается в стандартном модуле).
Листинг 3.82. Склонение ФИО
Public Sub PossessiveCase()
' Склоняем ФИО в родительный падеж
Dim strName1 As String, strName2 As String, strName3 As
String
strName1 = dhGetName(ActiveCell, 1) ' Выделяем имя
strName2 = dhGetName(ActiveCell, 2) ' Выделяем фамилию
strName3 = dhGetName(ActiveCell, 3) ' Выделяем отчество
' Если в ячейке менее трех слов – закрытие процедуры
If strName1 = "" Or strName2 = "" Or strName3 = "" Then Exit
Sub
' Склоняем
Cells(ActiveCell.Row, ActiveCell.Column) = dhPossessive( _
strName1, strName2, strName3)
End Sub
Public Sub DativeCase()
' Объявление переменных
Dim strName1 As String, strName2 As String, strName3 As
String
strName1 = dhGetName(ActiveCell, 1)
strName2 = dhGetName(ActiveCell, 2)
strName3 = dhGetName(ActiveCell, 3)
' Если в ячейке менее трех слов – закрытие процедуры
If Len(strName1) = 0 Or Len(strName2) = 0 Or Len(strName3) = 0 _
Then Exit Sub
Cells(ActiveCell.Row, ActiveCell.Column) = dhDative( _
strName1, strName2, strName3)
End Sub
Function dhPossessive(strName1 As String, strName2 As String, _
strName3 As String) As String
Dim fMan As Boolean
' Определяем, мужские ФИО или женские
fMan = (Right(strName3, 1) = "ч")
' Склонение фамилии в родительный падеж
If Len(strName1) > 0 Then
If fMan Then
' Склонение мужской фамилии
Select Case Right(strName1, 1)
Case "о", "и", "я", "а"
dhPossess ive = strName1
Case "й"
dhPossessive = Mid(strName1, 1, Len(strName1) – 2) + «ого»
Case Else
dhPossessive = strName1 + "а"
End Select
Else
' Склонение женской фамилии
Select Case Right(strName1, 1)
Case "о", "и", "б", "в", "г", "д", "ж", "з", "к", "л", _
"м", "н", "п", "р", "с", "т", "ф", "х", "ц", "ч", _
"ш", "щ", "ь"
dhPossessive = strName1
Case "я"
dhPossessive = Mid(strName1, 1, Len(strName1) – 2) & «ой»
Case Else
dhPossessive = Mid(strName1, 1, Len(strName1) – 1) & «ой»
End Select
End If
dhPossessive = dhPossessive & " "
End If
' Склонение имени в родительный падеж
If Len(strName2) > 0 Then
If fMan Then
' Склонение мужского имени
Select Case Right(strName2, 1)
Case "й", "ь"
dhPossessive = dhPossessive & Mid(strName2, _
1, Len(strName2) – 1) & "я"
Case Else
dhPossessive = dhPossessive & strName2 & "а"
End Select
Else
Читать дальше
Конец ознакомительного отрывка
Купить книгу