If (rst.NoMatch) Then

MsgBox "Ошибка при чтении таблицы элементов кнопочной формы."

rst.Close

dbs.Close

Exit Function

End If

Select Case rst![Command]

' Переход к другой кнопочной форме.

Case conCmdGotoSwitchboard

Me.Filter = "[ItemNumber] = 0 AND [SwitchboardID]=" & rst![Argument]

' Открытие формы в режиме добавления записей.

Case conCmdOpenFormAdd

DoCmd.OpenForm rst![Argument], , , , acAdd

Открытие формы.

Case conCmdOpenFormBrowse

DoCmd.OpenForm rst![Argument]

' Открытие отчета.

Case conCmdOpenReport

DoCmd.OpenReport rst![Argument], acPreview

' Настройка кнопочной формы.

Case conCmdCustomizeSwitchboard

' Обработка ситуации, когда диспетчер

' кнопочных форм не установлен

' (например, при сокращенной установке).

On Error Resume Next

Application.Run "WZMAIN80.sbm_Entry"

If (Err <> 0) Then MsgBox "Команда недоступна."

On Error GoTo 0

' Обновление формы.

Me.Filter = "[ItemNumber] = 0 AND [Argument] = 'по умолчанию' "

Me.Caption = Nz(Me![ItemText], "")

FillOptions

' Выход из приложения.

Case conCmdExitApplication

CloseCurrentDatabase

' Запуск макроса.

Case conCmdRunMacro

DoCmd.RunMacro rst![Argument]

' Выполнение программы.

Case conCmdRunCode

Application.Run rst![Argument]

' Другие команды не поддерживаются.

Case Else

MsgBox "Неизвестная команда."

End Select

' Закрытие набора записей и базы данных.

rst.Close

dbs.Close

HandleButtonClick_Exit:

Exit Function

HandleButtonClick_Err:

' Если выполнение прервано пользователем,

' сообщение об ошибке не выводится. Вместо этого

' выполнение продолжается со следующей строки.

If (Err = conErrDoCmdCancelled) Then

Resume Next

Else

MsgBox "Ошибка при выполнении команды.", vbCritical

Resume HandleButtonClick_Exit

End If

End Function

Листинг программы для формы “Издание”

Option Compare Database

Dim FlCorr As Boolean

Option Explicit

'Открытие окна диалога Поиска.

Private Sub Find_Record_Click()

On Error GoTo Err_Find_Record_Click

Screen.PreviousControl.SetFocus

DoCmd.DoMenuItem acFormBar, acEditMenu, 10, , acMenuVer70

Exit_Find_Record_Click:

Exit Sub

Err_Find_Record_Click:

MsgBox Err.Description

Resume Exit_Find_Record_Click

End Sub

Private Sub Form_Load()

'Загрузка формы

DoCmd.Maximize

FlCorr = True

продолжение приложения 2

End Sub

Private Sub Кнопка86_Click()

On Error GoTo Err_Кнопка86_Click

Dim stDocName As String

Dim stLinkCriteria As String

stDocName = "Аннотация"

stLinkCriteria = "[Идентификатор издания]=" & Me![Идентификатор издания]

DoCmd.OpenForm stDocName, , , stLinkCriteria

Exit_Кнопка86_Click:

Exit Sub

Err_Кнопка86_Click:

MsgBox Err.Description

Resume Exit_Кнопка86_Click

End Sub

Private Sub Цена_Click()

On Error GoTo Err_Цена_Click

Dim stDocName As String

Dim stLinkCriteria As String

stDocName = "Цена"

stLinkCriteria = "[Идентификатор издания]=" & Me![Идентификатор издания]

DoCmd.OpenForm stDocName, , , stLinkCriteria

Exit_Цена_Click:

Exit Sub

Err_Цена_Click:

MsgBox Err.Description

Resume Exit_Цена_Click

End Sub

'Просмотр библиографического описания по ГОСТ

Private Sub ГОСТ_Click()

On Error GoTo Err_ГОСТ_Click

Dim stDocName As String

Dim stLinkCriteria As String

stDocName = "Описание по ГОСТ"

stLinkCriteria = "[Идентификатор издания]=" & Me![Идентификатор издания]

DoCmd.OpenForm stDocName, , , stLinkCriteria

Exit_ГОСТ_Click:

Exit Sub

Err_ГОСТ_Click:

MsgBox Err.Description

Resume Exit_ГОСТ_Click

End Sub

'Вызов формы поиска по фильтру

Private Sub Фильтр_Click()

On Error GoTo Err_Фильтр_Click

Dim stDocName As String

Dim stLinkCriteria As String

stDocName = "Фильтр"

DoCmd.OpenForm stDocName, , , stLinkCriteria

Exit_Фильтр_Click:

Exit Sub

Err_Фильтр_Click:

MsgBox Err.Description

Resume Exit_Фильтр_Click

End Sub

Private Sub Тематическая_справка_Click()

On Error GoTo Err_Тематическая_справка_Click

'Просмотр отчета для отобранных значений в форме "Издение"

Dim stDocName As String

Dim strFilter As String

stDocName = "Тематическая справка"

strFilter = Me.Filter

DoCmd.OpenReport stDocName, acPreview, , strFilter

Exit_Тематическая_справка_Click:

Exit Sub

Err_Тематическая_справка_Click:

MsgBox Err.Description

Resume Exit_Тематическая_справка_Click

End Sub

Private Sub Кнопка187_Click()

On Error GoTo Err_Кнопка187_Click

'Печать каталожной карточки

Dim strFilter As String

Dim stDocName As String

stDocName = "Каталожная карточка"

strFilter = Me.Filter

DoCmd.OpenReport stDocName, acViewNormal, strFilter

Exit_Кнопка187_Click:

Exit Sub

Err_Кнопка187_Click:

MsgBox Err.Description

Resume Exit_Кнопка187_Click

End Sub

Листинг программы для формы “Библиографическое описание издание”

Option Compare Database

Dim FlCorr As Boolean

Option Explicit

Private Sub Find_Record_Click()

'Открыть форму диалога Поиска.

On Error GoTo Err_Find_Record_Click

Screen.PreviousControl.SetFocus

DoCmd.DoMenuItem acFormBar, acEditMenu, 10, , acMenuVer70

Exit_Find_Record_Click:

Exit Sub

Err_Find_Record_Click:

MsgBox Err.Description

Resume Exit_Find_Record_Click

End Sub

Private Sub Form_Load()

FlCorr = True

DoCmd.Maximize

End Sub

Private Sub Form_Error(DataErr As Integer, Response As Integer)

'Перехват дубликата значения

Dim strMsg As String

Const conDupKey = 3022

If DataErr = conDupKey Then

strMsg = "Вы ввели дубликат идентификатора книги"

strMsg = strMsg & "Пожалуйста введите новое значение"

MsgBox strMsg

[Идентификатор издания].SetFocus

Response = acDataErrContinue

End If

End Sub

Private Sub Form_AfterUpdate()

' Обновляет поле со списком "Языковой материал" после изменения записи.

Me!ТипИздания.Requery

End Sub

Private Sub INVNum_Click()

On Error GoTo Err_INVNum_Click

Dim stDocName As String

Dim stLinkCriteria As String

stDocName = "Добавление инвентарных записей"

stLinkCriteria = "[Идентификатор издания]=" & Me![Идентификатор издания]

DoCmd.OpenForm stDocName, , , stLinkCriteria

Exit_INVNum_Click:

Exit Sub

Err_INVNum_Click:

MsgBox Err.Description

Resume Exit_INVNum_Click

End Sub

Private Sub ТипИздания_NotInList(NewData As String, Response As Integer)

'Добавление пользователем нового элемента в список

Dim ctl As Control

'Определяет поле со списком в качестве объекта элемента управления

Set ctl = Me!ТипИздания

'Подтверждение на ввод нового значения

If MsgBox("Собираетесь добавить новое значение в список?", vbOKCancel) _

Then

'Установить аргумент Response для отображения добавляемого значения

Response = acDataErrAdded

'Добавляет строку в список значений в источник строки

Debug.Print ctl.RowSource

ctl.RowSource = ctl.RowSource & ";" & NewData

Debug.Print ctl.RowSource

Else

'Если нажата кнопка отмена - выдается сообщение об ошибке

Страницы: 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15