Создание перекрестного отчета с изменяющимся числом столбцов
Рассмотрим возможности обработки событий в отчете на примере отчета "Выработка сотрудников". Этот отчет строится на базе перекрестного запроса и показывает выработку сотрудников отдела продаж за год по месяцам. Максимальное число столбцов в отчете — 14. Первый столбец содержит фамилии сотрудников, следующие двенадцать столбцов — выработку для каждого месяца и последний столбец — итоговый. (Как выглядит этот отчет, мы показывали в разд. "Перекрестные отчеты"гл. 10.)
В качестве источника данных для такого запроса используется перекрестный запрос "Выработка сотрудников", представленный на рис. 13.35.
Рис. 13.35. Перекрестный запрос "Выработка сотрудников"
Поле "Отпускная цена" является вычисляемым, и для его вычисления используется формула
CCur(CLng([Заказано].[Цена]*
[Количество]*(1-[Скидка])*100)/100)
Создание такого отчета требует написания довольно большого числа процедур обработки событий.
В запросе в качестве критерия выборки заказов указан год — 1998. Нужно вывести приглашение пользователю, чтобы он, в свою очередь, мог ввести желаемый год. Это можно сделать при открытии отчета. Сначала нужно создать базовый набор записей для отчета и посчитать, сколько получилось столбцов в этом наборе. Следующая процедура обрабатывает событие Открытие (On Open) отчета:
Private Sub Report_0pen(Cancel As Integer) On Error Resume Next
' Создает базовый набор записей для отчета.
Dim intX As Integer Dim qdf As QueryDef Dim frm As Form Dim StrSql As String
' Связывает переменную с текущей базой данных.
Set dbsReport = CurrentDb
' Открывает запрос (объект QueryDef).
Set qdf = dbsReport.QueryDefs("Выработка сотрудников")
' Запрашивает год.
Год = InputBox("Отчет за год:", "Год", 1998) StrSql = Left(qdf.SQL, InStr(qdf.SQL, "where") - 1) & " WHERE_ (((Year([ДатаИсполнения])) = " & Год & "))" & Right(qdf.SQL, Len(qdf.SQL) - InStr(qdf.SQL, "GROUP BY") + 1) qdf.SQL = StrSql
' Открывает набор записей
Set rstReport = qdf.OpenRecordset()
' Определяет количество столбцов в перекрестном запросе.
intColumnCount = rstReport.Fields.Count End Sub
Здесь переменная intColumnCount должна быть определена на уровне модуля формы, т. к. она используется и другими процедурами данной формы.
Для событий Форматирование (On Format) верхнего колонтитула (листинг 13.1) и области данных отчета (листинг 13.2) необходимо определить процедуры, которые бы заполняли поля заголовков и значений и скрывали неиспользуемые поля.
Листинг 13.1. Процедура обработки события Форматирование верхнего колонтитула
Private Sub PageHeader()_Format(Cancel As Integer,_FormatCount As Integer) Dim intx As Integer
' Помещает заголовки столбцов в поля в верхнем колонтитуле.
Me("Head" + Format(0)) = rstReport(0).Name For intX = 1 To intColumnCount - 1 Me("Head" + Format(intX)) = _MonthRus(CInt(rstReport(intX).Name)) Next intX
' Вводит в ближайшее свободное поле заголовок "Итого".
Me("Head" + Format(intColumnCount)) = "Итого"
' Скрывает пустые поля в верхнем колонтитуле.
For intX = (intColumnCount +1) То conTotalColumns - 1 Me("Head" + Format(intX)).Visible = False Next intX End Sub
В этой процедуре используется функция MonthRus, которая по порядковому номеру месяца выдает его название. Мы здесь не приводим текста этой функции, надеясь, что вы сможете написать ее сами conTotalColumns — константа, которая описана на уровне модуля и значение которой определяет максимальное число столбцов в отчете. В данном примере conTotalColumns равна 14.
Листинг 13.2. Процедура обработки события Форматирование области данных 1
Private Sub Detaill_Format(Cancel As Integer,_ FormatCount As Integer)
' Вводит значения в поля и скрывает пустые поля.
Dim intX As Integer
' Проверяет, что не достигнут конец набора записей.
If Not rstReport.EOF Then
'Помещает значения из набора записей в поля области данных
If Me.FormatCount = 1 Then For intX = 0 To intColumnCount - 1
' Преобразует пустые значения в 0.
Me ("Col" + Format(intX)} = _xtabCnulls(rstReport(intX)) Next intX
' Скрывает неиспользуемые поля в области данных.
For intX = intColumnCount + 1 То conTotalColumns - 1 Me("Col" + Format(intX)).Visible = False Next intX
' Переходит к следующей записи в наборе. rstReport.Move
Next End If End If End Sub
Свойство FormatCount отчета содержит значение, равное количеству столбцов для форматирования, поэтому в процедуре проверяется это свойство, и присвоение значений полям в области данных выполняется, только если это значение не 0. В процедуре используется также функция xtabCnulls, преобразующая пустое значение в 0.
Для события Печать (On Print) области данных отчета нужно создать процедуру, которая бы суммировала значения по строке отчета, выводила полученное значение в последнем столбце и, кроме того, добавляла эту сумму в массив итоговых значений по столбцам (листинг 13.3). Массив итоговых значений по столбцам IngRgColumnTotal и переменная IngReportTotal, определяющая общий итог, должны быть описаны на уровне модуля. Кроме того, они должны быть инициализированы, т. е. им нужно присвоить начальные значения 0. Это можно сделать в процедуре обработки события Загрузка (On Load) отчета.
Листинг 13.3. Процедура обработки события Печать области данных
Private Sub Detaill_Print(Cancel As Integer, PrintCount As Integer) Dim intX As Integer Dim IngRowTotal As Long
' Вычисляет сумму по строке и добавляет ее к итоговому значению. ' по столбцу и общему итогу
If Me.PrintCount = 1 Then IngRowTotal = 0 For intX = 1 To intColumnCount - 1
' Начиная со столбца 1 (первый столбец с перекрестными значениями), вычисляет сумму по строке.
lngRowTotal = IngRowTotal + Me("Col" + Format(intX))
' Добавляет итоговое значение для текущего столбца.
IngRgColurenTotal(intX) = IngRgColumnTotal(intX) + Me("Col" + Format(intX)) Next intX
' Заносит сумму по строке в поле в области данных.
Me("Col" + Format(intColumnCount)) = IngRowTotal
' Прибавляет сумму по строке к общему итогу.
IngReportTotal = IngReportTotal + IngRowTotal End If End Sub
Процедура обработки события Печать (On Print) примечания отчета должна заполнить поля примечания итоговыми значениями по столбцам из массива IngRgColumnTotal (листинг 13.4).
Листинг 13.4. Процедура обработки события Печать примечания
Private Sub ReportFooter4_Print(Cancel As Integer, PrintCount As Integer) Dim intX As Integer
' Помещает суммы по столбцам в поля примечания.
For intX = 1 То intColumnCount - 1 Me("Tot" + Format(intX)) = IngRgColumnTotal(intX) Next intX
' Помещает общий итог в поле примечания.
Me("Tot" + Format(intColumnCount)) = IngReportTotal
' Скрывает неиспользуемые поля в примечании отчета.
For intX = intColumnCount + 1 То conTotalColumns - 1 Me("Tot" + Format(intX)).Visible = False Next intX End Sub
Для корректной работы нужно еще добавить две небольшие процедуры в свойства отчета:
- при закрытии отчета нужно закрыть базовый набор записей — обработка события Закрытие (On Close);
- при отсутствии данных в базовом наборе записей нужно закрыть этот набор и прервать формирование отчета — событие Отсутствие данных (On No Data).
Ниже приведены обе эти процедуры (листинги 13.5 и 13.6).
Листинг 13.5. Процедура обработки события Закрытие отчета
Private Sub Report_Close() On Error Resume Next rstReport.Close End Sub
Листинг 13.6. Процедура обработки события Отсутствие данных отчета
Private Sub Report_NoData(Cancel As Integer) MsgBox "He найдены записи, удовлетворяющие указанным условиям.", vbExclamation, "Записи не найдены" rstReport.Close Cancel = True End Sub