Автоматизированной информационная библиотечная система

Таблица 1.12.

Структура таблицы “Издательства”

Таблица 1.13.

Структура таблицы “Инвентарная книга”

Таблица 1.14.

Структура таблицы “Справочник ББК”

Таблица 1.15.

Структура таблицы “Сведения о читателях”

Таблица 1.16.

Структура таблицы “Читательский формуляр”

ПРИЛОЖЕНИЕ 2

Листинг программы главной кнопочной формы

Option Compare Database

Option Explicit

Private Sub Form_LostFocus()

DoCmd.Maximize

End Sub

Private Sub Form_Open(Cancel As Integer)

' Свертывание окна базы данных,

' инициализация формы.

' Переход на страницу кнопочной формы, отмеченную для использования по умолчанию.

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

Me.FilterOn = True

End Sub

Private Sub Form_Current()

' Обновление заголовка и заполнение

' списка команд.

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

FillOptions

End Sub

Private Sub FillOptions()

' Заполнение команд для страницы

' кнопочной формы.

' Число кнопок в форме.

Const conNumButtons = 8

Dim dbs As Database

Dim rst As Recordset

Dim strSQL As String

Dim intOption As Integer

' Установка фокуса на первую кнопку формы,

' скрытие всех кнопок формы, кроме первой.

' Поле с фокусом скрыть нельзя.

Me![Option1].SetFocus

For intOption = 2 To conNumButtons

Me("Option" & intOption).Visible = False

Me("OptionLabel" & intOption).Visible = False

Next intOption

' Открытие таблицы элементов кнопочной формы,

' поиск первого элемента текущей страницы формы.

Set dbs = CurrentDb()

strSQL = "SELECT * FROM [Элементы кнопочной формы]"

strSQL = strSQL & " WHERE [ItemNumber] > 0 AND [SwitchboardID]=" & Me![SwitchboardID]

strSQL = strSQL & " ORDER BY [ItemNumber];"

Set rst = dbs.OpenRecordset(strSQL)

' Вывод сообщения при отсутствии элементов

' на странице кнопочной формы. В остальных

' случаях - заполнение страницы элементами.

If (rst.EOF) Then

Me![OptionLabel1].Caption = "Элементы кнопочной формы отсутствуют"

Else

While (Not (rst.EOF))

Me("Option" & rst![ItemNumber]).Visible = True

Me("OptionLabel" & rst![ItemNumber]).Visible = True

Me("OptionLabel" & rst![ItemNumber]).Caption = rst![ItemText]

rst.MoveNext

Wend

End If

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

rst.Close

dbs.Close

End Sub

Private Function HandleButtonClick(intBtn As Integer)

' Эта функция вызывается при нажатии кнопки.

' Аргумент intBtn указывает, какая кнопка была нажата.

' Константы для выполняемых команд.

Const conCmdGotoSwitchboard = 1

Const conCmdOpenFormAdd = 2

Const conCmdOpenFormBrowse = 3

Const conCmdOpenReport = 4

Const conCmdCustomizeSwitchboard = 5

Const conCmdExitApplication = 6

Const conCmdRunMacro = 7

Const conCmdRunCode = 8

' Особая ошибка.

Const conErrDoCmdCancelled = 2501

Dim dbs As Database

Dim rst As Recordset

On Error GoTo HandleButtonClick_Err

' Поиск записи, соответствующей нажатой кнопке,

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

Set dbs = CurrentDb()

Set rst = dbs.OpenRecordset("Элементы кнопочной формы", dbOpenDynaset)

rst.FindFirst "[SwitchboardID]=" & Me![SwitchboardID] & " AND [ItemNumber]=" & intBtn

' Если нужная запись не найдена, вывод

' сообщения об ошибке и выход из функции.

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

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

Response = acDataErrContinue

ctl.Undo

End If

End Sub

'Private Sub Form_AfterUpdate()

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

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

'End Sub

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

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

DoCmd.GoToRecord , , acNewRec

FlCorr = False

Exit_Кнопка84_Click:

Exit Sub

Err_Кнопка84_Click:

MsgBox Err.Description

Resume Exit_Кнопка84_Click

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()

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

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

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

Private Sub Удаление_Click()

On Error GoTo Err_Удаление_Click

DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70

DoCmd.DoMenuItem acFormBar, acEditMenu, 6, , acMenuVer70

Exit_Удаление_Click:

Exit Sub

Err_Удаление_Click:

MsgBox Err.Description

Resume Exit_Удаление_Click

End Sub

Листинг программы формы “Просмотр книг”

Option Compare Database

Option Explicit

Private Sub cmdSome_Click()

Dim strWhere As String, varItem As Variant

Dim gstrWhereBook As String

If Me!lstBName.ItemsSelected.Count = 0 Then

'ExitSub

End If

For Each varItem In Me!lstBName.ItemsSelected

strWhere = strWhere & _

Me!lstBName.Column(0, varItem) & ","

Next varItem

' Удаление лишней запятой в строке IN

strWhere = Left$(strWhere, Len(strWhere) - 1)

' Открытие формы для просмотра всех данных о книге с отбором

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

'выделенных книг

gstrWhereBook = "[Идентификатор издания] IN (" & _

strWhere & ")"

DoCmd.OpenForm "Издание", WhereCondition:=gstrWhereBook

End Sub

Private Sub Form_Load()

DoCmd.Maximize

End Sub

Private Sub lstBName_DblClick(Cancel As Integer)

Dim strWhere As String, varItem As Variant

Dim gstrWhereBook As String

If Me!lstBName.ItemsSelected.Count = 0 Then

'ExitSub

End If

For Each varItem In Me!lstBName.ItemsSelected

strWhere = strWhere & _

Me!lstBName.Column(0, varItem) & ","

Next varItem

' Удаление лишней запятой в строке IN

strWhere = Left$(strWhere, Len(strWhere) - 1)

' Открытие формы для просмотра всех данных о книге с отбором

'выделенных книг

gstrWhereBook = "[Идентификатор издания] IN (" & _

strWhere & ")"

DoCmd.OpenForm "Издание", WhereCondition:=gstrWhereBook

End Sub

Листинг программы для формы “Краткие сведения о книгах”

Option Compare Database

Option Explicit

`Реакция на нажатие кнопки “Подробнее”

Private Sub Detalis_Click()

Dim gstrWhereBook As String

' Открывает форму для книги, выбранной в списке

gstrWhereBook = "[Идентификатор издания] = " & _

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

DoCmd.OpenForm FormName:="Описание по ГОСТ", _

WhereCondition:=gstrWhereBook

DoCmd.Close acForm, Me.Name

Forms![Описание по ГОСТ].SetFocus

End Sub

Листинг формы “Сведения в архив”

(форма вызывается для отправки в архив сведений о списанной литературе, вызывается двойным щелчком мыши на любой записи формы “Библиографическое описание”)

Option Compare Database

Option Explicit

Private Sub Post()

'Предлагает архивировать выбранные записи

Dim wsp As Workspace, dbsCurrent As Database

Dim rstPost As Recordset

Dim intCount As Integer, blnInTrans As Boolean

Dim varReturn As Variant, strMsg As String

Dim strSQLArchive As String, strSQLDelete As String

Dim dtmCutOff As Double, intChoice As Integer

Dim dat As Date, dtmCutPr As String

Dim A As String

On Error GoTo Err_Post

dat = Date

blnInTrans = False

Set wsp = DBEngine.Workspaces(0)

Set dbsCurrent = CurrentDb()

' Подпрограмма архивации

ArchiveTrans:

intChoice = MsgBox("Будете добавлять в архив новые записи?", _

vbYesNo + vbQuestion, "Архивация?")

If intChoice = 7 Then

GoTo Exit_Post

Else

'Отключение предупреждения Access

DoCmd.SetWarnings False

dtmCutOff = Me![Инвентарный номер]

If Not Me![Состояние] = "на руках" Then

strSQLArchive = "INSERT INTO [Списанная литература] ([Инвентарный номер], [Идентификатор издания], [Цена издания], [Дата списания], [Причина списания], [Название книги]) " & _

"VALUES (Forms![Сведения в архив]![Инвентарный номер], Forms![Сведения в архив]![Идентификатор издания], Forms![Сведения в архив]![Цена издания], Forms![Сведения в архив]![Дата списания], Forms![Сведения в архив]![Причина списания], Forms![Сведения в архив]![Название книги]);"

DoCmd.RunSQL (strSQLArchive)

strSQLDelete = "DELETE [Инвентарная книга].* FROM [Инвентарная книга] " & _

"WHERE ([Инвентарная книга]![Инвентарный номер])= " & dtmCutOff & ";"

DoCmd.RunSQL (strSQLDelete)

'Сброс предупреждения.

DoCmd.SetWarnings True

'выход из формы

DoCmd.Close

Else

MsgBox ("Книга находиться на руках и не подлежит архивации")

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

DoCmd.Close

End If

End If

Exit_Post:

Exit Sub

Err_Post:

MsgBox Err.Description

Resume Exit_Post

End Sub

Private Sub Архив_Click()

Post

End Sub

Листинг программы для формы “Фильтр”

Option Compare Database

Dim iD As Integer

Option Explicit

Private Sub Form_Load()

DoCmd.Maximize

Me!Связь2 = "AND"

Me!Связь3 = "AND"

Me!Связь4 = "AND"

Me!Связь5 = "AND"

Me!Связь6 = "AND"

Me!Связь7 = "AND"

Me!Связь8 = "AND"

Me!Связь9 = "AND"

Me!Связь10 = "AND"

End Sub

Private Sub Связь2_Click()

If Me!Связь3 = "AND" Then

Me!Связь3 = "OR"

Else: Me!Связь3 = "AND"

End If

End Sub

Private Sub Связь3_Click()

If Me!Связь3 = "AND" Then

Me!Связь3 = "OR"

Else: Me!Связь3 = "AND"

End If

End Sub

Private Sub Связь4_Click()

If Me!Связь4 = "AND" Then

Me!Связь4 = "OR"

Else: Me!Связь4 = "AND"

End If

End Sub

Private Sub Связь5_Click()

If Me!Связь5 = "AND" Then

Me!Связь5 = "OR"

Else: Me!Связь5 = "AND"

End If

End Sub

Private Sub Связь6_Click()

If Me!Связь6 = "AND" Then

Me!Связь6 = "OR"

Else: Me!Связь6 = "AND"

End If

End Sub

Private Sub Связь7_Click()

If Me!Связь7 = "AND" Then

Me!Связь7 = "OR"

Else: Me!Связь7 = "AND"

End If

End Sub

Private Sub Связь8_Click()

If Me!Связь8 = "AND" Then

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

Me!Связь8 = "OR"

Else: Me!Связь8 = "AND"

End If

End Sub

Private Sub Связь9_Click()

If Me!Связь9 = "AND" Then

Me!Связь9 = "OR"

Else: Me!Связь9 = "AND"

End If

End Sub

Private Sub Связь10_Click()

If Me!Связь10 = "AND" Then

Me!Связь10 = "OR"

Else: Me!Связь10 = "AND"

End If

End Sub

Private Sub Поиск_Click()

Dim db As Database, rst As Recordset

Dim lngCount As Long, intRtn As Integer

Dim S As String, gstrWhereBook As String

'Очистка главной строки фильтра

gstrWhereBook = ""

DoCmd.Hourglass False

gstrWhereBook = ""

'Проверка поля ББК и создание условия

If Not IsNull(Me!ББК) Then

gstrWhereBook = "[ББК] Like " & Chr$(34) & Me!ББК

gstrWhereBook = gstrWhereBook & Chr$(34)

End If

'Проверка поля Название и создание условия

If Not IsNull(Me!Название) Then

If gstrWhereBook = "" Then

gstrWhereBook = " [Название книги] LIKE " & Chr$(34) & Me!Название

Else: gstrWhereBook = gstrWhereBook & " " & Me![Связь3] & " [Название книги] LIKE " & Chr$(34) & Me!Название

End If

If Right$(Me!Название, 1) = "*" Then

gstrWhereBook = gstrWhereBook & Chr$(34)

Else: gstrWhereBook = gstrWhereBook & "*" & Chr$(34)

End If

End If

'Проверка поля Автор и создание условия

If Not IsNull(Me!Автор) Then

If gstrWhereBook = "" Then

gstrWhereBook = " [Автор] LIKE " & Chr$(34) & Me!Автор

Else: gstrWhereBook = gstrWhereBook & " " & Me![Связь4] & " [Автор] LIKE " & Chr$(34) & Me!Автор

End If

If Right$(Me!Автор, 1) = "*" Then

gstrWhereBook = gstrWhereBook & Chr$(34)

Else: gstrWhereBook = gstrWhereBook & "*" & Chr$(34)

End If

End If

'Проверка поля Другие авторы и создание условия

If Not IsNull(Me![Другие авторы]) Then

If gstrWhereBook = "" Then

gstrWhereBook = " [Другие авторы] LIKE " & Chr$(34) & Me![Другие авторы]

Else: gstrWhereBook = gstrWhereBook & " " & Me![Связь5] & " [Другие авторы] LIKE " & _

Chr$(34) & Me![Другие авторы]

End If

If Right$(Me![Другие авторы], 1) = "*" Then

gstrWhereBook = gstrWhereBook & Chr$(34)

Else: gstrWhereBook = gstrWhereBook & "*" & Chr$(34)

End If

End If

'Проверка поля Ответственность и создание условия

If Not IsNull(Me![Ответственность]) Then

If gstrWhereBook = "" Then

gstrWhereBook = " [Ответственность] LIKE " & Chr$(34) & Me![Ответственность]

Else: gstrWhereBook = gstrWhereBook & " " & Me![Связь6] & " [Ответственность] LIKE " & _

Chr$(34) & Me![Ответственность]

End If

If Right$(Me![Ответственность], 1) = "*" Then

gstrWhereBook = gstrWhereBook & Chr$(34)

Else: gstrWhereBook = gstrWhereBook & "*" & Chr$(34)

End If

End If

Построение строки IN для кода типа книги

If Not IsNull(Me![Материал]) Then

If gstrWhereBook = "" Then

gstrWhereBook = " [ТипИздания] LIKE " & Chr$(34) & Me![Материал]

Else: gstrWhereBook = gstrWhereBook & " " & " AND [ТипИздания] LIKE " & _

Chr$(34) & Me![Материал]

End If

If Right$(Me![Материал], 1) = "*" Then

gstrWhereBook = gstrWhereBook & Chr$(34)

Else: gstrWhereBook = gstrWhereBook & "*" & Chr$(34)

End If

End If

'Проверка поля Номер тома и создание условия

If Not IsNull(Me![Номер тома]) Then

If gstrWhereBook = "" Then

gstrWhereBook = " [Номер тома/книги] LIKE " & Chr$(34) & Me![Номер тома]

Else: gstrWhereBook = gstrWhereBook & " " & Me![Связь7] & " [Номер тома/книги] LIKE " & _

Chr$(34) & Me![Номер тома]

End If

If Right$(Me![Номер тома], 1) = "*" Then

gstrWhereBook = gstrWhereBook & Chr$(34)

Else: gstrWhereBook = gstrWhereBook & "*" & Chr$(34)

End If

End If

'Проверка поля Название тома и создание условия

If Not IsNull(Me![Название тома]) Then

If gstrWhereBook = "" Then

gstrWhereBook = " [Название тома/книги] LIKE " & Chr$(34) & Me![Название тома]

Else: gstrWhereBook = gstrWhereBook & " " & Me![Связь8] & " [Название тома/книги] LIKE " & _

Chr$(34) & Me![Название тома]

End If

If Right$(Me![Название тома], 1) = "*" Then

gstrWhereBook = gstrWhereBook & Chr$(34)

Else: gstrWhereBook = gstrWhereBook & "*" & Chr$(34)

End If

End If

If gstrWhereBook = "" Then

MsgBox "Условий не задано.", vbExclamation, "Фильтр"

'ExitSub

End If

'Проверка поля Ответственность за том и создание условия

If Not IsNull(Me![Ответственность за том]) Then

If gstrWhereBook = "" Then

gstrWhereBook = " [Ответственность за том] LIKE " & Chr$(34) & Me![Ответственность за том]

Else: gstrWhereBook = gstrWhereBook & " " & Me![Связь9] & " [Ответственность за том] LIKE " & _

Chr$(34) & Me![Ответственность за том]

End If

If Right$(Me![Ответственность за том], 1) = "*" Then

gstrWhereBook = gstrWhereBook & Chr$(34)

Else: gstrWhereBook = gstrWhereBook & "*" & Chr$(34)

End If

End If

If gstrWhereBook = "" Then

MsgBox "Условий не задано.", vbExclamation, "Фильтр"

End If

'Проверка поля "Серия" и создание условия

If Not IsNull(Me![Название серии]) Then

If gstrWhereBook = "" Then

gstrWhereBook = " [Название серии] LIKE " & Chr$(34) & Me![Название серии]

Else: gstrWhereBook = gstrWhereBook & " " & Me![Связь10] & " [Название серии] LIKE " & _

Chr$(34) & Me![Название серии]

End If

If Right$(Me![Название серии], 1) = "*" Then

gstrWhereBook = gstrWhereBook & Chr$(34)

Else: gstrWhereBook = gstrWhereBook & "*" & Chr$(34)

End If

End If

'Поиск на основе построенного запроса

Me.Visible = False

DoCmd.Hourglass True

If IsLoaded("Издание") Then

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

Forms![Издание].SetFocus

DoCmd.ApplyFilter , gstrWhereBook

If Forms![Издание].RecordsetClone.RecordCount = 0 Then

DoCmd.Hourglass False

MsgBox "Нет книг, удовлетворяющих вашим условиям", vbExclamation, "Фильтр"

DoCmd.ShowAllRecords

'Forms![Форма ввода библиографического описания издания].Visiable = False

Me.Visible = True

Exit Sub

End If

DoCmd.Hourglass False

Else

Set db = CurrentDb

Set rst = db.OpenRecordset( _

"SELECT DISTINCTROW " & _

"ШИФРЫ.[Идентификатор издания] " & _

"FROM [Издание] " & _

"WHERE " & gstrWhereBook & ";")

If rst.RecordCount = 0 Then

DoCmd.Hourglass False

MsgBox "Нет книг, удовлетворяющих вашим условиям", vbExclamation, "Фильтр"

gstrWhereBook = ""

Me.Visible = True

rst.Close

Exit Sub

End If

'Переход к последней строке для получения числа записей

rst.MoveLast

lngCount = rst.RecordCount

DoCmd.Hourglass False

Если найдено более 10 записей - запрос на просмотр только кратких сведений о книгах

If lngCount > 10 Then

intRtn = MsgBox("Найдено более 10 книг. " & _

"Нажмите Да для просмотра кратких сведений о " & lngCount & _

"найденных книгах," & _

" или Нет - для просмотра полных сведений об этих книгах." & _

" Нажав Отмена Вы предпримете новую попытку поиска", _

vbInformation + vbYesNoCancel, "Фильтр")

Select Case intRtn

Case vbCancel

Me.Visible = True

Exit Sub

Case vbYes

DoCmd.OpenForm _

FormName:="Краткие сведения о книгах", _

WhereCondition:=gstrWhereBook

DoCmd.Close acForm, Me.Name

Forms![Краткие сведения о книгах].SetFocus

Exit Sub

End Select

End If

'Если нажата кнопка Нет или найдено менее 10 книг,

' Отображаем полные данные

DoCmd.OpenForm _

FormName:="Издание", _

WhereCondition:=gstrWhereBook

'If Not IsNull(Автор) Then

' Forms![Издание]![Вкладка100] = 1

' End If

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

End If

' Закрываем форму

DoCmd.Close acForm, Me.Name

End Sub

Листинг программы формы “Читательский формуляр”

Option Compare Database

Option Explicit

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

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

'Просмотр сведений о читателях

Dim stDocName As String

Dim stLinkCriteria As String

stDocName = "Сведения о читателях"

stLinkCriteria = "[Номер читательского формуляра]=" & Me![Номер читательского формуляра]

DoCmd.OpenForm stDocName, , , stLinkCriteria

Exit_Кнопка6_Click:

Exit Sub

Err_Кнопка6_Click:

MsgBox Err.Description

Resume Exit_Кнопка6_Click

End Sub

Private Sub Поиск_Click()

On Error GoTo Err_Поиск_Click

Screen.PreviousControl.SetFocus

DoCmd.DoMenuItem acFormBar, acEditMenu, 10, , acMenuVer70

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

Exit_Поиск_Click:

Exit Sub

Err_Поиск_Click:

MsgBox Err.Description

Resume Exit_Поиск_Click

End Sub

Private Sub Формуляр_DblClick(Cancel As Integer)

'Фильтр по введенному номеру читательского формуляра

Dim strFilter As String

strFilter = Me![Формуляр]

Me.Filter = "[Номер читательского формуляра]= " & strFilter

Me.FilterOn = True

End Sub

Private Sub Добавление_Click()

On Error GoTo Err_Добавление_Click

Dim frm As Form

'Открытие формы как скрытой

DoCmd.OpenForm "Ввод записи в формуляр читателя", acNormal, , , , acHidden

'Присвоение переменной ссылки на форму

Set frm = Forms![Ввод записи в формуляр читателя]

'Копирование данных в форму

frm![Номер читательского формуляра] = Me![Номер читательского формуляра]

frm![Инвентарный номер книги].SetFocus

'вывод скрытой формы

frm.Visible = True

Exit_Добавление_Click:

Exit Sub

Err_Добавление_Click:

MsgBox Err.Description

Resume Exit_Добавление_Click

End Sub

Листинг программы формы “Список литературы”

Option Compare Database

Option Explicit

Private Sub Номер_формуляра_AfterUpdate()

Dim Cancel As Integer

Dim strFilter As String

strFilter = Me![Номер формуляра]

Me.Filter = "[Номер читательского формуляра]>= " & strFilter

Me.FilterOn = True

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:

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

Exit Sub

Err_Формуляр_Click:

MsgBox Err.Description

Resume Exit_Формуляр_Click

End Sub

Private Sub Добавление_Click()

On Error GoTo Err_Добавление_Click

Dim stDocName As String

stDocName = "Сведения о читателях"

'Открываем форму "Сведения о читателях" для добавления новой записи

DoCmd.OpenForm stDocName

DoCmd.GoToRecord , , acNewRec

Exit_Добавление_Click:

Exit Sub

Err_Добавление_Click:

MsgBox Err.Description

Resume Exit_Добавление_Click

End Sub

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

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

Screen.PreviousControl.SetFocus

DoCmd.DoMenuItem acFormBar, acEditMenu, 10, , acMenuVer70

Exit_Кнопка15_Click:

Exit Sub

Err_Кнопка15_Click:

MsgBox Err.Description

Resume Exit_Кнопка15_Click

End Sub

Private Sub Поиск_Click()

On Error GoTo Err_Поиск_Click

Screen.PreviousControl.SetFocus

DoCmd.DoMenuItem acFormBar, acEditMenu, 10, , acMenuVer70

Exit_Поиск_Click:

Exit Sub

Err_Поиск_Click:

MsgBox Err.Description

Resume Exit_Поиск_Click

End Sub

Private Sub Formular_Click()

On Error GoTo Err_Formular_Click

Dim stDocName As String

Dim stLinkCriteria As String

stDocName = "Читательский формуляр"

stLinkCriteria = "[Номер читательского формуляра]=" & Me![Номер читательского формуляра]

DoCmd.OpenForm stDocName, , , stLinkCriteria

Exit_Formular_Click:

Exit Sub

Err_Formular_Click:

MsgBox Err.Description

Resume Exit_Formular_Click

End Sub

Список литературы

“С компьютером на ты”: Методическое пособие для библиотек по информационным технологиям и Интернет. Вып. 3./ Ред.-сост. Л.А. Казаченкова. - М.: Либерея, 2000. -112 с.

Цветкова И.Б. Лингвистическое обеспечение библиотечных информационных ресурсов// Доклад, Всероссийское совещание директоров федеральных и региональных библиотек России. М., 1999.

Российский коммуникативный формат представления библиографических записей в машиночитаемой форме(Рос. вариант UNIMARC)/ И. Б. Цветкова и др.; М-во культуры PФ, Рос. библ. ассоц. - СПб.: Изд-во РНБ, 1998.

Вейскас Д. Эффективная работа с Microsoft Access 97. - СПб.: Издательство “Питер”, 2000. - 976 с.: ил.

Учебно-методическое пособие по курсу “Учебно-методическое пособие по курсу технико-экономическое проектирование”. Сост. Ю.В. Брусницын, А.Н. Гармаш. - Таганрог, ТРТУ, 1998 г. - 35 с.

Охрана труда в вычислительных центрах: Учебное пособие для учащихся средних специальных учебных заведений по специальности “Программирование для быстродействующих математических машин”/ Ю. Г. Сибаров, Н.Н. Нагинаев. - М.: Машиностроение, 1985. - 176 с., ил.

Белах Н.В., Петраков Н.Я., Русаков В. П. Доходы, предложения и цены -- проблема сбалансированности//Изв. АН СССР. Сер. экон. 1982. № 2. С. 71-77.

Охрана труда в радио- и электронной промышленности: Учебник для техникумов. - 2-е изд., перераб. и доп. / С.П. Павлов, Л.С. Виноградов, Н.Ф. Крылова и др.; Под ред. С.П. Павлова. - М.: Радио и связь, 1985. - 200 с., ил.

Страницы: 1, 2, 3, 4