Смекни!
smekni.com

Автоматизированной информационная библиотечная система (стр. 13 из 14)

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

EndIf

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

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

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

DimstDocNameAsString

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

DimfrmAsForm

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

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

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

Setfrm = 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