AccessVBA

31

DoCmd.OpenForm "Сотрудники" End Sub

Sub ЗапросAccess ()

DoCmd.SetWarnings False

DoCmd.OpenForm "Сотрудники", acDesign, , , , acHidden

DoCmd.OpenQuery "Запрос1" DoCmd.Close acForm, "Сотрудники"

DoCmd.SetWarnings True

End Sub

Меню

Меню создаются и редактируются под управлением редактора меню или с помощью процедур, размещаемых в модулях. Редактор меню

представлен вкладкой Команды меню Вид .Панели инструментов

.Настройка…

Различают встроенные меню приложения и авторские меню

пользователя. Каждому пункту авторского меню соответствует индивидуальный макрос или функция. Редактор меню позволяет удалять любой пункт меню, открыв его контекстное меню и выбрав из него Сброс или Удалить при открытом окне Настройка. При этом встроенные меню не удаляются, а скрываются. В любое меню можно добавить новый пункт через вкладку Команды меню Вид .Панели инструментов .Настройка,

перетащив необходимый элемент из списка Команды в меню.

Для программирования строк меню используются объекты классов

CommandBars и CommandBar из библиотеки Microsoft Office. Первый из классов хранит все строки встроенных меню. Он служит инструментом использования меню приложения и создания авторских меню. Второй класс представляет все пункты конкретного меню. Он служит инструментом использования пунктов меню приложения и создания авторских пунктов. Ссылки на пункты меню определяются свойством Controls.

Для отображения контекстных меню используется метод ShowPopup, а для удаления всех новых меню, не выведенных на экран, – методы Delete и Reset.

Примеры

Sub ВсеСтрокиМеню ()

For Each строкаМеню In CommandBars

Debug.Print строкаМеню.Index, " ", строкаМеню.Name

Next End Sub

Sub ВсеПунктыМеню ()

For Each пункт In CommandBars ("Menu Bar").Controls

список = список & пункт.Index & " " & пункт.Caption & Chr(13)

32

Next

MsgBox список

End Sub

Sub ЕщеСтрокаМеню ()

Set новоеМеню = CommandBars.Add (Name:="Игры", _

Position:=msoBarFloating, MenuBar:=False, Temporary:=True) новоеМеню.Visible = True

End Sub

Sub НаполнениеСтрокиМеню ()

Set меню = CommandBars (CommandBars.Count)

Set новыйПункт = меню.Controls.Add (Type:=msoControlPopup)

новыйПункт.Caption = "Информация"

Set подпункт1 = новыйПункт.Controls.Add (Type:=msoControlPopup)

подпункт1.Caption = "О меню"

Set подпункт2 = новыйПункт.Controls.Add (Type:=msoControlPopup)

With подпункт2

.Caption = "О панелях"

.Enabled = True

.OnAction = "процедураИлиМакрос" End With

End Sub

Sub УдалениеМеню ()

For Each меню In CommandBars

If Not меню.BuiltIn And Not меню.Visible Then меню.Delete

Next End Sub

Sub ВосстановлениеМеню ()

On Error Resume Next

For i = 1 To CommandBars.Count

CommandBars (i).Reset

Next

End Sub

Панели инструментов

VBA позволяет изменить изображение любой кнопки панели инструментов с помощью меню Вид .Панели инструментов .Настройка.

При программировании панели инструментов рассматриваются как разновидности меню.

Примеры

Sub НоваяПанельИнструментов ()

On Error GoTo ошибка

Dim новаяПанель As CommandBar

Set новаяПанель = CommandBars.Add (Name:="Игры", _ Position:=msoBarFloating, MenuBar:=False, Temporary:=True)

33

With новаяПанель.Controls

.Add Type:=msoControlEdit

.Add Type:=msoControlButton , Id:=4

.Add Type:=msoControlButton , Id:=21

.Add Type:=msoControlDropdown

.Add Type:=msoControlComboBox End With

новаяПанель.Controls (1).OnAction = "мойМакрос"

новаяПанель.Visible = True

номерПанели = CommandBars.Count

MsgBox "Перед вами панель " & новаяПанель.Name _ & " номер " & номерПанели

ошибка:

CommandBars ("Игры").Delete

End Sub

Sub НовыйЭлемент ()

On Error GoTo ошибка

Dim панель As CommandBar

Dim элемент As CommandBarComboBox Set панель = CommandBars (3)

Set элемент = панель.Controls.Add (Type:=msoControlDropdown)

With элемент

.AddItem "Кофе", 1

.AddItem "Чай", 2

.AddItem "Сок", 3

.DropDownWidth = 75

.DropDownLines = 3

.ListIndex = 3

End With панель.Visible = True

ошибка: элемент.Delete

End Sub

Sub ПанелиИнструментов ()

For Each панель In CommandBars

If панель.Index > 2 And панель.Index < 19 Then панель.Visible = False

Next панель

MsgBox "Все панели инструментов скрыты." & Chr (13) & _

"Сейчас они будут последовательно возвращаться" For Each панель In CommandBars

If панель.Index > 2 And панель.Index < 19 Then

панель.Visible = True

MsgBox "Это панель " & панель.Name

End If Next панель

If MsgBox ("Убрать лишние ?", vbYesNo) = vbYes Then For счетчик = 18 To 5 Step -1

CommandBars (счетчик).Visible = False Next счетчик

34

End If

End Sub

Начальная установка интерфейса

База данных Access открывается в соответствии с настройками меню

Сервис .Параметры запуска или макросом AutoExec.

Примеры

Sub ПараметрыЗапуска ()

ЗадатьСвойство "StartupForm", dbText, "МояФорма"

ЗадатьСвойство "AppTitle", dbText, "Моя форма"

ЗадатьСвойство "StartupShowDBWindow", dbBoolean, False

ЗадатьСвойство "StartupShowStatusBar", dbBoolean, False ЗадатьСвойство "AllowBuiltinToolbars", dbBoolean, True

ЗадатьСвойство "AllowFullMenus", dbBoolean, True ЗадатьСвойство "AllowBreakIntoCode", dbBoolean, False

ЗадатьСвойство "AllowSpecialKeys", dbBoolean, True

ЗадатьСвойство "AllowBypassKey", dbBoolean, TrueEnd Sub MsgBox(“OK”)

End Sub

Function ЗадатьСвойство (имяСвойства As String, типСвойства As Variant, _

значениеСвойства As Variant) As Integer Const conPropNotFoundError = 3270

On Error GoTo еслиНетТакогоСвойства

CurrentDb.Properties (имяСвойства) = значениеСвойства ЗадатьСвойство = True

конец:

Exit Function

еслиНетТакогоСвойства:

If Err = conPropNotFoundError Then ' свойство не установлено

Set свойство = CurrentDb.CreateProperty (имяСвойства, _

типСвойства, значениеСвойства)

CurrentDb.Properties.Append свойство Resume Next

Else

' неясная ошибка ЗадатьСвойство = False

Resume конец

End If End Function

Sub АнтиШифт ()

On Error GoTo добавитьСвойство

If MsgBox ("Нужен ли Шифт?", vbYesNo) = vbYes Then

нуженЛи = True

Else

нуженЛи = False

35

End If

CurrentDb.Properties ("AllowBypassKey") = нуженЛи

MsgBox "Свойство установлено"

Exit Sub

добавитьСвойство:

CurrentDb.Properties.Append _

CurrentDb.CreateProperty ("AllowBypassKey", DbBoolean, нуженЛи)

MsgBox "Свойство добавлено и установлено" End Sub

Sub УдалитьСвойство ()

On Error GoTo нетТакогоСвойства

CurrentDb.Properties.Delete "AllowBypassKey" Exit Sub

нетТакогоСвойства:

MsgBox "Нет такого свойства" End Sub