46695 (588433), страница 11
Текст из файла (страница 11)
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 " & _
"ШИФРЫ.[Идентификатор издания] " & _
![](https://s.studizba.com/z.php?f=/templates/si/i/noavatar.png&w=100&h=100&t=1"){kind=avatar}
