Автоматизированной информационная библиотечная система
Дипломная работа - Компьютеры, программирование
Другие дипломы по предмету Компьютеры, программирование
µние приложения 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!Название) The