https://pastein.ru/t/Jpg
Загрузка данных
Option Compare Database
Option Explicit
'=====================================================================
' БАЗА ДАННЫХ «БИБЛИОТЕКА» - автоматическая сборка в Microsoft Access
'
' КАК ЗАПУСТИТЬ:
' 1. Создайте ПУСТУЮ базу данных (Файл - Создать - Пустая база данных).
' Пустую "Таблицу1" закройте без сохранения.
' 2. Нажмите Alt+F11 (откроется редактор VBA), меню Insert (Вставка) -
' Module (Модуль). В окне модуля нажмите Ctrl+A, Delete и вставьте
' весь этот текст (Ctrl+V).
' 3. Нажмите Ctrl+G (окно Immediate), введите BuildLibrary и Enter.
'
' ПРОЦЕДУРЫ:
' BuildLibrary - создать всё + тестовые данные
' BuildLibraryEmpty - создать всё, но таблицы пустые
' ResetLibrary - удалить всё созданное (чтобы начать заново)
'=====================================================================
Private gLog As String
Public Sub BuildLibrary()
BuildAll True
End Sub
Public Sub BuildLibraryEmpty()
BuildAll False
End Sub
Private Sub BuildAll(ByVal withData As Boolean)
Dim db As DAO.Database
Set db = CurrentDb
If TableExists(db, "Книги") Then
MsgBox "Таблица «Книги» уже существует. Запускайте сборку только в ПУСТОЙ базе." & vbCrLf & _
"Чтобы начать заново, выполните процедуру ResetLibrary.", vbExclamation, "Библиотека"
Exit Sub
End If
gLog = ""
CreateTables db
CreateRelations db
If withData Then FillData db
CreateQueries db
CreateForms
CreateReports
Application.RefreshDatabaseWindow
If Len(gLog) = 0 Then
MsgBox "Готово!" & vbCrLf & vbCrLf & _
"Создано: 5 таблиц, 10 запросов, 5 форм, 5 отчётов." & vbCrLf & _
"Всё лежит в области навигации слева. Сохраните базу (Ctrl+S).", vbInformation, "Библиотека"
Else
MsgBox "Сборка завершена, но часть объектов не создалась:" & vbCrLf & vbCrLf & gLog & vbCrLf & _
"Недостающее можно сделать вручную по гайду.", vbExclamation, "Библиотека"
End If
End Sub
'---------------------------------------------------------------------
' Вспомогательные процедуры
'---------------------------------------------------------------------
Private Function TableExists(db As DAO.Database, ByVal nm As String) As Boolean
Dim t As DAO.TableDef
For Each t In db.TableDefs
If t.Name = nm Then
TableExists = True
Exit Function
End If
Next t
End Function
Private Sub RunSql(db As DAO.Database, ByVal sql As String)
On Error GoTo EH
db.Execute sql, dbFailOnError
Exit Sub
EH:
gLog = gLog & "SQL: " & Left$(sql, 70) & " ... -> " & Err.Description & vbCrLf
End Sub
Private Sub MakeQuery(db As DAO.Database, ByVal nm As String, ByVal sql As String)
On Error GoTo EH
db.CreateQueryDef nm, sql
Exit Sub
EH:
gLog = gLog & "Запрос " & nm & ": " & Err.Description & vbCrLf
End Sub
Private Sub AddRel(db As DAO.Database, ByVal relName As String, ByVal parentTbl As String, _
ByVal childTbl As String, ByVal fld As String)
Dim rel As DAO.Relation
Dim f As DAO.Field
On Error GoTo EH
Set rel = db.CreateRelation(relName, parentTbl, childTbl, dbRelationUpdateCascade)
Set f = rel.CreateField(fld)
f.ForeignName = fld
rel.Fields.Append f
db.Relations.Append rel
Exit Sub
EH:
gLog = gLog & "Связь " & parentTbl & " - " & childTbl & ": " & Err.Description & vbCrLf
End Sub
'---------------------------------------------------------------------
' Таблицы и связи
'---------------------------------------------------------------------
Private Sub CreateTables(db As DAO.Database)
RunSql db, "CREATE TABLE [Разделы] ([КодРаздела] COUNTER CONSTRAINT PK_Razdely PRIMARY KEY, [НазваниеРаздела] TEXT(100) NOT NULL)"
RunSql db, "CREATE TABLE [Авторы] ([КодАвтора] COUNTER CONSTRAINT PK_Avtory PRIMARY KEY, [ФИОАвтора] TEXT(100) NOT NULL)"
RunSql db, "CREATE TABLE [Абоненты] ([НомерАбонента] COUNTER CONSTRAINT PK_Abonenty PRIMARY KEY, [ФИОАбонента] TEXT(100) NOT NULL, [ДомашнийАдрес] TEXT(150), [ДомашнийТелефон] TEXT(30))"
RunSql db, "CREATE TABLE [Книги] ([ШифрКниги] TEXT(20) CONSTRAINT PK_Knigi PRIMARY KEY, [НазваниеКниги] TEXT(150) NOT NULL, [КодРаздела] LONG NOT NULL, [КодАвтора] LONG NOT NULL, [Издательство] TEXT(100), [ГодИздания] SHORT, [Местоположение] TEXT(60), [КоличествоЭкземпляров] SHORT NOT NULL)"
RunSql db, "CREATE TABLE [Выдача] ([КодВыдачи] COUNTER CONSTRAINT PK_Vydacha PRIMARY KEY, [НомерАбонента] LONG NOT NULL, [ШифрКниги] TEXT(20) NOT NULL, [ДатаВыдачи] DATETIME NOT NULL, [УстановленнаяДатаВозврата] DATETIME NOT NULL, [РеальнаяДатаВозврата] DATETIME)"
db.TableDefs.Refresh
End Sub
Private Sub CreateRelations(db As DAO.Database)
AddRel db, "Razd_Knigi", "Разделы", "Книги", "КодРаздела"
AddRel db, "Avt_Knigi", "Авторы", "Книги", "КодАвтора"
AddRel db, "Abon_Vyd", "Абоненты", "Выдача", "НомерАбонента"
AddRel db, "Kniga_Vyd", "Книги", "Выдача", "ШифрКниги"
End Sub
'---------------------------------------------------------------------
' Тестовые данные (вымышленные абоненты - замените своими)
'---------------------------------------------------------------------
Private Sub FillData(db As DAO.Database)
Dim a As Variant, p As Variant, i As Long, ret As String
a = Array("Художественная литература", "Детская литература", "Научно-популярная литература", _
"Информатика и вычислительная техника", "Поэзия и драматургия")
For i = 0 To UBound(a)
RunSql db, "INSERT INTO [Разделы] ([КодРаздела], [НазваниеРаздела]) VALUES (" & (i + 1) & ", '" & a(i) & "')"
Next i
a = Array("Толстой Лев Николаевич", "Достоевский Фёдор Михайлович", "Пушкин Александр Сергеевич", _
"Булгаков Михаил Афанасьевич", "Чехов Антон Павлович", "Гоголь Николай Васильевич", _
"Тургенев Иван Сергеевич", "Чуковский Корней Иванович", "Носов Николай Николаевич", _
"Хокинг Стивен", "Перельман Яков Исидорович", "Таненбаум Эндрю", _
"Дейт Крис", "Мартин Роберт")
For i = 0 To UBound(a)
RunSql db, "INSERT INTO [Авторы] ([КодАвтора], [ФИОАвтора]) VALUES (" & (i + 1) & ", '" & a(i) & "')"
Next i
a = Array("Иванов Сергей Петрович|г. Ступино, ул. Мира, д. 5, кв. 12|(49664) 2-45-18", _
"Петрова Анна Викторовна|г. Ступино, ул. Горького, д. 14, кв. 3|(49664) 3-12-77", _
"Сидоров Алексей Николаевич|г. Ступино, пр-т Победы, д. 21, кв. 45|(49664) 2-78-04", _
"Кузнецова Мария Андреевна|г. Ступино, ул. Заводская, д. 8, кв. 9|(49664) 4-05-61", _
"Смирнов Дмитрий Олегович|г. Ступино, ул. Садовая, д. 3, кв. 27|(49664) 2-33-90", _
"Попова Екатерина Сергеевна|г. Ступино, ул. Школьная, д. 17, кв. 6|(49664) 3-48-15", _
"Васильев Игорь Александрович|г. Ступино, ул. Центральная, д. 2, кв. 31|(49664) 2-91-52", _
"Морозова Ольга Ивановна|г. Ступино, ул. Лесная, д. 11, кв. 18|(49664) 4-27-36", _
"Новиков Артём Денисович|г. Ступино, ул. Советская, д. 25, кв. 7|(49664) 3-65-09", _
"Фёдорова Наталья Павловна|г. Ступино, ул. Парковая, д. 9, кв. 40|(49664) 2-14-83")
For i = 0 To UBound(a)
p = Split(a(i), "|")
RunSql db, "INSERT INTO [Абоненты] ([НомерАбонента], [ФИОАбонента], [ДомашнийАдрес], [ДомашнийТелефон]) VALUES (" & (i + 1) & ", '" & p(0) & "', '" & p(1) & "', '" & p(2) & "')"
Next i
' шифр | название | код раздела | код автора | издательство | год | местоположение | экземпляров
a = Array("101|Война и мир|1|1|Эксмо|2018|Стеллаж 1, шкаф 1|4", _
"102|Анна Каренина|1|1|Эксмо|2019|Стеллаж 1, шкаф 1|3", _
"103|Преступление и наказание|1|2|АСТ|2017|Стеллаж 1, шкаф 2|5", _
"104|Идиот|1|2|АСТ|2020|Стеллаж 1, шкаф 2|2", _
"105|Мастер и Маргарита|1|4|Азбука|2021|Стеллаж 1, шкаф 3|4", _
"106|Мёртвые души|1|6|Эксмо|2016|Стеллаж 1, шкаф 3|3", _
"107|Отцы и дети|1|7|АСТ|2015|Стеллаж 1, шкаф 4|3", _
"201|Евгений Онегин|5|3|Азбука|2019|Стеллаж 2, шкаф 1|4", _
"202|Вишнёвый сад|5|5|Эксмо|2017|Стеллаж 2, шкаф 1|2", _
"301|Мойдодыр|2|8|Детская литература|2018|Стеллаж 3, шкаф 1|3", _
"302|Приключения Незнайки и его друзей|2|9|Махаон|2019|Стеллаж 3, шкаф 1|4", _
"303|Айболит|2|8|Детская литература|2020|Стеллаж 3, шкаф 2|2", _
"401|Занимательная физика|3|11|АСТ|2018|Стеллаж 4, шкаф 1|3", _
"402|Краткая история времени|3|10|Амфора|2019|Стеллаж 4, шкаф 1|2", _
"403|Занимательная математика|3|11|АСТ|2017|Стеллаж 4, шкаф 2|2", _
"501|Компьютерные сети|4|12|Питер|2016|Стеллаж 5, шкаф 1|3", _
"502|Введение в системы баз данных|4|13|Вильямс|2018|Стеллаж 5, шкаф 1|2", _
"503|Чистый код|4|14|Питер|2019|Стеллаж 5, шкаф 2|3")
For i = 0 To UBound(a)
p = Split(a(i), "|")
RunSql db, "INSERT INTO [Книги] ([ШифрКниги], [НазваниеКниги], [КодРаздела], [КодАвтора], [Издательство], [ГодИздания], [Местоположение], [КоличествоЭкземпляров]) VALUES ('" & p(0) & "', '" & p(1) & "', " & p(2) & ", " & p(3) & ", '" & p(4) & "', " & p(5) & ", '" & p(6) & "', " & p(7) & ")"
Next i
' номер абонента | шифр книги | дата выдачи | установленная дата возврата | реальная дата возврата (пусто = не вернул)
a = Array("1|101|2026-09-01|2026-09-29|2026-09-27", _
"2|103|2026-09-05|2026-10-03|2026-10-10", _
"3|502|2026-09-10|2026-10-08|", _
"4|201|2026-10-01|2026-10-29|2026-10-28", _
"5|501|2026-10-05|2026-11-02|", _
"6|302|2026-10-12|2026-11-09|", _
"7|401|2026-10-14|2026-11-11|", _
"8|105|2026-10-15|2026-11-12|", _
"9|503|2026-10-20|2026-11-17|", _
"10|102|2026-10-22|2026-11-19|", _
"1|105|2026-10-26|2026-11-23|", _
"2|202|2026-09-20|2026-10-18|2026-10-17", _
"3|101|2026-10-27|2026-11-24|", _
"5|402|2026-09-15|2026-10-13|2026-10-12", _
"7|104|2026-10-28|2026-11-25|", _
"4|301|2026-10-30|2026-11-27|")
For i = 0 To UBound(a)
p = Split(a(i), "|")
If Len(p(4)) = 0 Then
ret = "Null"
Else
ret = "#" & p(4) & "#"
End If
RunSql db, "INSERT INTO [Выдача] ([КодВыдачи], [НомерАбонента], [ШифрКниги], [ДатаВыдачи], [УстановленнаяДатаВозврата], [РеальнаяДатаВозврата]) VALUES (" & (i + 1) & ", " & p(0) & ", '" & p(1) & "', #" & p(2) & "#, #" & p(3) & "#, " & ret & ")"
Next i
End Sub
'---------------------------------------------------------------------
' Запросы
'---------------------------------------------------------------------
Private Function AbonSql(ByVal whereClause As String) As String
Dim s As String
s = "SELECT [Абоненты].[ФИОАбонента] AS [ФИО абонента], [Абоненты].[ДомашнийАдрес] AS [Домашний адрес], [Абоненты].[ДомашнийТелефон] AS [Домашний телефон], "
s = s & "[Книги].[НазваниеКниги] AS [Название книги], [Выдача].[ДатаВыдачи] AS [Дата выдачи], [Выдача].[УстановленнаяДатаВозврата] AS [Установленная дата возврата] "
s = s & "FROM ([Абоненты] LEFT JOIN [Выдача] ON [Абоненты].[НомерАбонента] = [Выдача].[НомерАбонента]) LEFT JOIN [Книги] ON [Выдача].[ШифрКниги] = [Книги].[ШифрКниги] "
If Len(whereClause) > 0 Then s = s & "WHERE " & whereClause & " "
s = s & "ORDER BY [Абоненты].[ФИОАбонента], [Выдача].[ДатаВыдачи];"
AbonSql = s
End Function
Private Function BooksSql(ByVal whereClause As String) As String
Dim s As String
s = "SELECT [Разделы].[НазваниеРаздела] AS [Название раздела], [Книги].[НазваниеКниги] AS [Название книги], [Авторы].[ФИОАвтора] AS [ФИО автора], "
s = s & "[Книги].[Издательство] AS [Издательство], [Книги].[ГодИздания] AS [Год издания], [Книги].[КоличествоЭкземпляров] AS [Количество экземпляров], "
s = s & "(SELECT Count(*) FROM [Выдача] WHERE [Выдача].[ШифрКниги] = [Книги].[ШифрКниги] AND [Выдача].[РеальнаяДатаВозврата] Is Null) AS [Выдано экземпляров], "
s = s & "[Книги].[Местоположение] AS [Местоположение] "
s = s & "FROM [Авторы] INNER JOIN ([Разделы] INNER JOIN [Книги] ON [Разделы].[КодРаздела] = [Книги].[КодРаздела]) ON [Авторы].[КодАвтора] = [Книги].[КодАвтора] "
If Len(whereClause) > 0 Then s = s & "WHERE " & whereClause & " "
s = s & "ORDER BY [Разделы].[НазваниеРаздела], [Книги].[НазваниеКниги];"
BooksSql = s
End Function
Private Sub CreateQueries(db As DAO.Database)
Dim pAuthor As String, pTitle As String, pSection As String, pSurname As String, pYear As String
Dim s As String
pAuthor = "[Введите ФИО автора или его часть]"
pTitle = "[Введите название книги или его часть]"
pSection = "[Введите название раздела]"
pSurname = "[Введите фамилию абонента]"
pYear = "[Введите год издания]"
MakeQuery db, "Запрос_1_Абоненты_и_книги", AbonSql("")
MakeQuery db, "Запрос_2_Книги_в_библиотеке", BooksSql("")
MakeQuery db, "Запрос_3_Книги_автора", "PARAMETERS " & pAuthor & " Text; " & _
BooksSql("[Авторы].[ФИОАвтора] Like '*' & " & pAuthor & " & '*'")
MakeQuery db, "Запрос_4_Книга_по_названию", "PARAMETERS " & pTitle & " Text; " & _
BooksSql("[Книги].[НазваниеКниги] Like '*' & " & pTitle & " & '*'")
MakeQuery db, "Запрос_5_Книги_раздела", "PARAMETERS " & pSection & " Text; " & _
BooksSql("[Разделы].[НазваниеРаздела] Like '*' & " & pSection & " & '*'")
MakeQuery db, "Запрос_6_Абонент_по_фамилии", "PARAMETERS " & pSurname & " Text; " & _
AbonSql("[Абоненты].[ФИОАбонента] Like " & pSurname & " & '*'")
MakeQuery db, "Запрос_7_Книги_года", "PARAMETERS " & pYear & " Short; " & _
BooksSql("[Книги].[ГодИздания] = " & pYear)
' Итоговые запросы для отчётов
s = "SELECT 1 AS [Порядок], [Авторы].[ФИОАвтора] AS [Автор], Count([Книги].[ШифрКниги]) AS [Названий], Sum([Книги].[КоличествоЭкземпляров]) AS [Экземпляров] "
s = s & "FROM [Авторы] INNER JOIN [Книги] ON [Авторы].[КодАвтора] = [Книги].[КодАвтора] GROUP BY [Авторы].[ФИОАвтора] "
s = s & "UNION ALL SELECT 2, 'ВСЕГО В БИБЛИОТЕКЕ', Count([ШифрКниги]), Sum([КоличествоЭкземпляров]) FROM [Книги] "
s = s & "ORDER BY [Порядок], [Автор];"
MakeQuery db, "Запрос_Итоги_по_авторам", s
s = "SELECT [Разделы].[НазваниеРаздела] AS [Раздел], Count([Книги].[ШифрКниги]) AS [Названий], Sum([Книги].[КоличествоЭкземпляров]) AS [Экземпляров] "
s = s & "FROM [Разделы] INNER JOIN [Книги] ON [Разделы].[КодРаздела] = [Книги].[КодРаздела] "
s = s & "GROUP BY [Разделы].[НазваниеРаздела] ORDER BY [Разделы].[НазваниеРаздела];"
MakeQuery db, "Запрос_Итоги_по_разделам", s
s = "SELECT [Книги].[ГодИздания] AS [Год издания], Count([Книги].[ШифрКниги]) AS [Названий], Sum([Книги].[КоличествоЭкземпляров]) AS [Экземпляров] "
s = s & "FROM [Книги] GROUP BY [Книги].[ГодИздания] ORDER BY [Книги].[ГодИздания];"
MakeQuery db, "Запрос_Итоги_по_годам", s
End Sub
'---------------------------------------------------------------------
' Формы
' Описание поля: поле | подпись | тип (text/date/combo) | список или значение по умолчанию | ширина столбцов
'---------------------------------------------------------------------
Private Sub MakeForm(ByVal formName As String, ByVal src As String, specs As Variant)
Dim frm As Form
Dim ctl As Object, lbl As Object
Dim p As Variant
Dim tmp As String
Dim i As Long, y As Long
On Error GoTo EH
Set frm = CreateForm()
tmp = frm.Name
frm.RecordSource = src
y = 300
For i = 0 To UBound(specs)
p = Split(specs(i), "|")
If p(2) = "combo" Then
Set ctl = CreateControl(tmp, acComboBox, acDetail, , p(0), 3100, y, 5200, 330)
ctl.RowSource = p(3)
ctl.ColumnCount = 2
ctl.BoundColumn = 1
ctl.LimitToList = True
On Error Resume Next
If Len(p(4)) > 0 Then ctl.ColumnWidths = p(4)
On Error GoTo EH
Else
Set ctl = CreateControl(tmp, acTextBox, acDetail, , p(0), 3100, y, 5200, 330)
If p(2) = "date" Then
On Error Resume Next
ctl.Format = "Short Date"
If Len(p(3)) > 0 Then ctl.DefaultValue = p(3)
On Error GoTo EH
End If
End If
If ctl.Controls.Count > 0 Then
ctl.Controls(0).Caption = p(1)
ctl.Controls(0).Left = 150
ctl.Controls(0).Top = y
ctl.Controls(0).Width = 2800
Else
Set lbl = CreateControl(tmp, acLabel, acDetail, , , 150, y, 2800, 330)
lbl.Caption = p(1)
End If
y = y + 500
Next i
On Error Resume Next
frm.Width = 8700
frm.Section(acDetail).Height = y + 200
On Error GoTo EH
DoCmd.Close acForm, tmp, acSaveYes
DoCmd.Rename formName, acForm, tmp
Exit Sub
EH:
gLog = gLog & "Форма " & formName & ": " & Err.Description & vbCrLf
On Error Resume Next
DoCmd.Close acForm, tmp, acSaveNo
End Sub
Private Sub CreateForms()
MakeForm "Форма_Абоненты", "Абоненты", Array( _
"НомерАбонента|Номер абонента|text||", _
"ФИОАбонента|ФИО абонента|text||", _
"ДомашнийАдрес|Домашний адрес|text||", _
"ДомашнийТелефон|Домашний телефон|text||")
MakeForm "Форма_Книги", "Книги", Array( _
"ШифрКниги|Шифр книги|text||", _
"НазваниеКниги|Название книги|text||", _
"КодРаздела|Раздел|combo|SELECT [КодРаздела], [НазваниеРаздела] FROM [Разделы] ORDER BY [НазваниеРаздела]|0cm;8cm", _
"КодАвтора|Автор|combo|SELECT [КодАвтора], [ФИОАвтора] FROM [Авторы] ORDER BY [ФИОАвтора]|0cm;8cm", _
"Издательство|Издательство|text||", _
"ГодИздания|Год издания|text||", _
"Местоположение|Местоположение|text||", _
"КоличествоЭкземпляров|Количество экземпляров|text||")
MakeForm "Форма_Выдача_и_возврат", "Выдача", Array( _
"КодВыдачи|Код записи|text||", _
"НомерАбонента|Абонент|combo|SELECT [НомерАбонента], [ФИОАбонента] FROM [Абоненты] ORDER BY [ФИОАбонента]|0cm;8cm", _
"ШифрКниги|Книга|combo|SELECT [ШифрКниги], [НазваниеКниги] FROM [Книги] ORDER BY [НазваниеКниги]|2cm;8cm", _
"ДатаВыдачи|Дата выдачи|date|=Date()|", _
"УстановленнаяДатаВозврата|Установленная дата возврата|date|=Date()+28|", _
"РеальнаяДатаВозврата|Реальная дата возврата|date||")
MakeForm "Форма_Разделы", "Разделы", Array( _
"КодРаздела|Код раздела|text||", _
"НазваниеРаздела|Название раздела|text||")
MakeForm "Форма_Авторы", "Авторы", Array( _
"КодАвтора|Код автора|text||", _
"ФИОАвтора|ФИО автора|text||")
End Sub
'---------------------------------------------------------------------
' Отчёты
' Описание столбца: поле запроса | заголовок | ширина (twips, 567 = 1 см)
'---------------------------------------------------------------------
Private Sub MakeReport(ByVal repName As String, ByVal title As String, ByVal src As String, specs As Variant)
Dim rpt As Report
Dim ctl As Object, lbl As Object
Dim p As Variant
Dim tmp As String
Dim i As Long, x As Long, w As Long, totalW As Long
On Error GoTo EH
For i = 0 To UBound(specs)
p = Split(specs(i), "|")
totalW = totalW + CLng(p(2))
Next i
Set rpt = CreateReport()
tmp = rpt.Name
rpt.RecordSource = src
On Error Resume Next
rpt.Section(acPageHeader).Height = 1100
rpt.Section(acDetail).Height = 300
rpt.Section(acDetail).CanGrow = True
On Error GoTo EH
Set lbl = CreateReportControl(tmp, acLabel, acPageHeader, , , 0, 100, totalW, 400)
lbl.Caption = title
lbl.FontSize = 13
lbl.FontBold = True
x = 0
For i = 0 To UBound(specs)
p = Split(specs(i), "|")
w = CLng(p(2))
Set lbl = CreateReportControl(tmp, acLabel, acPageHeader, , , x, 600, w, 450)
lbl.Caption = p(1)
lbl.FontBold = True
lbl.FontSize = 9
Set ctl = CreateReportControl(tmp, acTextBox, acDetail, , , x, 0, w, 280)
ctl.ControlSource = "[" & p(0) & "]"
ctl.FontSize = 9
On Error Resume Next
ctl.CanGrow = True
If ctl.Controls.Count > 0 Then DeleteReportControl tmp, ctl.Controls(0).Name
On Error GoTo EH
x = x + w
Next i
' Номер страницы внизу
On Error Resume Next
Set ctl = CreateReportControl(tmp, acTextBox, acPageFooter, , , 0, 50, 3000, 280)
ctl.ControlSource = "=""Страница "" & [Page] & "" из "" & [Pages]"
ctl.FontSize = 9
If ctl.Controls.Count > 0 Then DeleteReportControl tmp, ctl.Controls(0).Name
On Error GoTo EH
DoCmd.Close acReport, tmp, acSaveYes
DoCmd.Rename repName, acReport, tmp
Exit Sub
EH:
gLog = gLog & "Отчёт " & repName & ": " & Err.Description & vbCrLf
On Error Resume Next
DoCmd.Close acReport, tmp, acSaveNo
End Sub
Private Sub CreateReports()
MakeReport "Отчет_Абоненты", "Абоненты библиотеки", "Запрос_1_Абоненты_и_книги", Array( _
"ФИО абонента|ФИО абонента|2000", _
"Домашний адрес|Домашний адрес|2600", _
"Домашний телефон|Домашний телефон|1400", _
"Название книги|Название книги|2300", _
"Дата выдачи|Дата выдачи|1100", _
"Установленная дата возврата|Установленная дата возврата|1300")
MakeReport "Отчет_Книги", "Книги, имеющиеся в библиотеке", "Запрос_2_Книги_в_библиотеке", Array( _
"Название раздела|Название раздела|1700", _
"Название книги|Название книги|2200", _
"ФИО автора|ФИО автора|1700", _
"Издательство|Издательство|1100", _
"Год издания|Год издания|600", _
"Количество экземпляров|Количество экземпляров|900", _
"Выдано экземпляров|Выдано экземпляров|800", _
"Местоположение|Местоположение|1500")
MakeReport "Отчет_Книги_по_авторам", "Количество книг по авторам", "Запрос_Итоги_по_авторам", Array( _
"Автор|Автор|5000", _
"Названий|Названий (книг)|1800", _
"Экземпляров|Экземпляров|1800")
MakeReport "Отчет_Книги_по_разделам", "Количество книг по разделам", "Запрос_Итоги_по_разделам", Array( _
"Раздел|Раздел|5000", _
"Названий|Названий (книг)|1800", _
"Экземпляров|Экземпляров|1800")
MakeReport "Отчет_Книги_по_годам", "Количество книг по годам издания", "Запрос_Итоги_по_годам", Array( _
"Год издания|Год издания|2000", _
"Названий|Названий (книг)|1800", _
"Экземпляров|Экземпляров|1800")
End Sub
'---------------------------------------------------------------------
' Удалить всё созданное (вместе с данными!)
'---------------------------------------------------------------------
Public Sub ResetLibrary()
Dim db As DAO.Database
Dim nm As Variant
If MsgBox("Будут УДАЛЕНЫ все таблицы (вместе с данными), запросы, формы и отчёты библиотеки. Продолжить?", _
vbYesNo + vbExclamation + vbDefaultButton2, "Библиотека") <> vbYes Then Exit Sub
Set db = CurrentDb
On Error Resume Next
For Each nm In Array("Razd_Knigi", "Avt_Knigi", "Abon_Vyd", "Kniga_Vyd")
db.Relations.Delete CStr(nm)
Next nm
For Each nm In Array("Запрос_1_Абоненты_и_книги", "Запрос_2_Книги_в_библиотеке", "Запрос_3_Книги_автора", _
"Запрос_4_Книга_по_названию", "Запрос_5_Книги_раздела", "Запрос_6_Абонент_по_фамилии", _
"Запрос_7_Книги_года", "Запрос_Итоги_по_авторам", "Запрос_Итоги_по_разделам", _
"Запрос_Итоги_по_годам")
db.QueryDefs.Delete CStr(nm)
Next nm
For Each nm In Array("Выдача", "Книги", "Абоненты", "Авторы", "Разделы")
db.TableDefs.Delete CStr(nm)
Next nm
For Each nm In Array("Форма_Абоненты", "Форма_Книги", "Форма_Выдача_и_возврат", "Форма_Разделы", "Форма_Авторы")
DoCmd.DeleteObject acForm, CStr(nm)
Next nm
For Each nm In Array("Отчет_Абоненты", "Отчет_Книги", "Отчет_Книги_по_авторам", _
"Отчет_Книги_по_разделам", "Отчет_Книги_по_годам")
DoCmd.DeleteObject acReport, CStr(nm)
Next nm
Application.RefreshDatabaseWindow
MsgBox "Готово. Можно запускать BuildLibrary заново.", vbInformation, "Библиотека"
End Sub