"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