Программирование на Visual Basic

18. У меня в отчете несколько листов. Приходится общую сумму листа считать вручную. Общую сумму отчета делать умею, но вот каждого листа в отдельности нет. Этот небольшой пример решает такую задачу.

Private sumPage As Currency, strMsg As String

Private Sub ОбластьДанных_Format(Cancel As Integer, FormatCount As Integer)
    sumPage = Me.Цена.Value + sumPage
    strMsg = strMsg  Me.Пункт  ".  "  Me.Цена.Value  vbNewLine
End Sub

Private Sub НижнийКолонтитул_Format(Cancel As Integer, FormatCount As Integer)
    Me.PageИтого.Value = sumPage
    MsgBox strMsg
    sumPage = 0
    strMsg = ""
End Sub

16. Используя специальное свойства отчетов Access, где можно указать специальную структуру параметров для печати, Вы сможете из Access управлять размерами бумаги для печати.

Option Compare Database
Option Explicit

Private Type str_DEVMODE
    RGB As String * 94 'Промежуточная переменная для копирования
End Type

'Полное описание структуры дано в модуле: p001.mdb
Private Type type_DEVMODE
    strDeviceName As String * 16
    intSpecVersion As Integer
    intDriverVersion As Integer
    intSize As Integer
    intDriverExtra As Integer
    lngFields As Long
    intOrientation As Integer
    intPaperSize As Integer
    intPaperLength As Integer
    intPaperWidth As Integer
    intScale As Integer
    intCopies As Integer
    intDefaultSource As Integer
    intPrintQuality As Integer
    intColor As Integer
    intDuplex As Integer
    intResolution As Integer
    intTTOption As Integer
    intCollate As Integer
    strFormName As String * 16
    lngPad As Long
    lngBits As Long
    lngPW As Long
    lngPH As Long
    lngDFI As Long
    lngDFr As Long
End Type

'==============================================================
' Открытие отчета
Private Sub Form_Open(Cancel As Integer)
    funChangeReport False
End Sub

'==============================================================
' Открыть отчет
Private Sub butChange_Click()
    On Error GoTo 999
    DoCmd.OpenReport "Пример 16", acViewPreview 'Открываем конструктор отчета
    Exit Sub
999:
    MsgBox Err.Description
    Err.Clear
End Sub

'==============================================================
' Изменяем размеры отчета
Private Sub myWidth_AfterUpdate()
    funChangeReport True
End Sub

'==============================================================
' Изменяем размеры отчета
Private Sub myLength_AfterUpdate()
    funChangeReport True
End Sub

'==============================================================
' Изменяем размеры отчета
'
Private Sub funChangeReport(boolChange As Boolean)
    Dim DevString As str_DEVMODE
    Dim DM As type_DEVMODE
    Dim strDevModeExtra As String
    Dim rpt As Report
    On Error GoTo 999
    DoCmd.OpenReport "Пример 16", acDesign 'Открываем конструктор отчета
    Set rpt = Reports("Пример 16") 'Определяем адрес отчета
    If Not IsNull(rpt.PrtDevMode) Then
        strDevModeExtra = rpt.PrtDevMode
        DevString.RGB = strDevModeExtra 'Структура отчета
        LSet DM = DevString 'Заполняем структуру
        If boolChange = True Then 'Изменение отчета
            On Error Resume Next
            rpt.Width = 32000
            Err.Clear
            DM.lngFields = DM.lngFields Or _
              DM.intPaperSize Or DM.intPaperLength Or DM.intPaperWidth
            DM.intPaperSize = 256 'Устанавливаем тип листа
            DM.intPaperWidth = Me.myWidth * 10 'Новая ширина
            DM.intPaperLength = Me.myLength * 10 'Новая длина
            LSet DevString = DM  'Обновляем свойство
            Mid(strDevModeExtra, 1, 94) = DevString.RGB
            rpt.PrtDevMode = strDevModeExtra
            DoCmd.Close acReport, "Пример 16", acSaveYes 'Закрываем отчет
        Else 'Отображение данных
            Me.myWidth = DM.intPaperWidth / 10 'Ширина
            Me.myLength = DM.intPaperLength / 10 'Ширина
            DoCmd.Close acReport, "Пример 16" 'Закрываем отчет
        End If
    End If
    Exit Sub
999:
    MsgBox Err.Description
End Sub

17. Это свойство вывода на печать поможет напечатать отчет в несколько колонок (как на газетном листе). Настраивается через конструктор.

Option Compare Database
Option Explicit

Private Type str_DEVMODE
    RGB As String * 94 'Промежуточная переменная для копирования
End Type

'Полное описание структуры дано в модуле: p001.mdb
Private Type type_DEVMODE
    strDeviceName As String * 16
    intSpecVersion As Integer
    intDriverVersion As Integer
    intSize As Integer
    intDriverExtra As Integer
    lngFields As Long
    intOrientation As Integer
    intPaperSize As Integer
    intPaperLength As Integer
    intPaperWidth As Integer
    intScale As Integer
    intCopies As Integer
    intDefaultSource As Integer
    intPrintQuality As Integer
    intColor As Integer
    intDuplex As Integer
    intResolution As Integer
    intTTOption As Integer
    intCollate As Integer
    strFormName As String * 16
    lngPad As Long
    lngBits As Long
    lngPW As Long
    lngPH As Long
    lngDFI As Long
    lngDFr As Long
End Type

'==============================================================
' Открытие отчета
Private Sub Form_Open(Cancel As Integer)
    funChangeReport False
End Sub

'==============================================================
' Открыть отчет
Private Sub butChange_Click()
    On Error GoTo 999
    DoCmd.OpenReport "Пример 16", acViewPreview 'Открываем конструктор отчета
    Exit Sub
999:
    MsgBox Err.Description
    Err.Clear
End Sub

'==============================================================
' Изменяем размеры отчета
Private Sub myWidth_AfterUpdate()
    funChangeReport True
End Sub

'==============================================================
' Изменяем размеры отчета
Private Sub myLength_AfterUpdate()
    funChangeReport True
End Sub

'==============================================================
' Изменяем размеры отчета
'
Private Sub funChangeReport(boolChange As Boolean)
    Dim DevString As str_DEVMODE
    Dim DM As type_DEVMODE
    Dim strDevModeExtra As String
    Dim rpt As Report
    On Error GoTo 999
    DoCmd.OpenReport "Пример 16", acDesign 'Открываем конструктор отчета
    Set rpt = Reports("Пример 16") 'Определяем адрес отчета
    If Not IsNull(rpt.PrtDevMode) Then
        strDevModeExtra = rpt.PrtDevMode
        DevString.RGB = strDevModeExtra 'Структура отчета
        LSet DM = DevString 'Заполняем структуру
        If boolChange = True Then 'Изменение отчета
            On Error Resume Next
            rpt.Width = 32000
            Err.Clear
            DM.lngFields = DM.lngFields Or _
              DM.intPaperSize Or DM.intPaperLength Or DM.intPaperWidth
            DM.intPaperSize = 256 'Устанавливаем тип листа
            DM.intPaperWidth = Me.myWidth * 10 'Новая ширина
            DM.intPaperLength = Me.myLength * 10 'Новая длина
            LSet DevString = DM  'Обновляем свойство
            Mid(strDevModeExtra, 1, 94) = DevString.RGB
            rpt.PrtDevMode = strDevModeExtra
            DoCmd.Close acReport, "Пример 16", acSaveYes 'Закрываем отчет
        Else 'Отображение данных
            Me.myWidth = DM.intPaperWidth / 10 'Ширина
            Me.myLength = DM.intPaperLength / 10 'Ширина
            DoCmd.Close acReport, "Пример 16" 'Закрываем отчет
        End If
    End If
    Exit Sub
999:
    MsgBox Err.Description
End Sub

11. Используя этот пример, Вы можете добавить поля даже в файлы, которые не изменяются в конструкторе.

Dim rstRpt As Recordset 'Запрос отчета
Dim x0 As Single 'Крайняя правая точка

'===============================================================
' Открываем запрос отчета и определяем параметры секции
Private Sub Report_Open(Cancel As Integer)
Dim dbs As Database, c As Control
    Set dbs = CurrentDb 'Выбираем базу данных
    Set rstRpt = dbs.OpenRecordset(Me.RecordSource) 'Открываем запрос
    'Находим последнее поле в отчете
    x0 = 0 'Инициализация
    For Each c In Me.Section(acDetail).Controls 'Просматриваем всю секцию
       If x0  c.Left + c.Width Then _
               x0 = c.Left + c.Width 'Крайняя правая точка в отчете
    Next c
End Sub

'===============================================================
' Находим запись отчета и печатаем текст
'
Private Sub ОбластьДанных_Print(Cancel As Integer, PrintCount As Integer)
Dim rpt As Report
    On Error GoTo 999
    'Находим в запросе нужную запись
    rstRpt.FindFirst "[Номенклатура]="  Me.Controls("Номенклатура")
    'Форматируем поле и добавляем в отчет после всех полей
    funDrawControl Me, 567 * 2, Format(rstRpt!Цена, "# ##0.00") 'Добавляем в ячейку текст
999:
    Err.Clear
End Sub

'===============================================================
' Рисуем элемент управления для отчета
'   myWidth - ширина поля
'   strDate - данные поля
'   Внимание! TextWidth может вернуть неправильный результат,
'             требуется пакет обновления SR-1
Private Function funDrawControl(rpt As Report, myWidth As Single, strDate) As Long
Dim c As Control
    
    'Пример текста в поле, который строится по образцу
    'Set c = Me.Section(acDetail).Controls("Номенклатура") 'Образец шрифта
    'Me.FontName = c.FontName  'Назначаем шрифт ячейки
    'Me.FontSize = c.FontSize  'Назначаем высоту текста
    'Me.ScaleMode = 1 'Назначаем масштаб в твипах
    
    'Расчитываем позицию текста и печаем его
    rpt.CurrentY = (rpt.Height - rpt.TextHeight("0")) / 2 'y-координата текста
    rpt.CurrentX = x0 + myWidth - rpt.TextWidth(strDate) 'x-координата текста
    rpt.ForeColor = RGB(255, 0, 0) 'Цвет текста
    rpt.Print strDate 'Печатаем текст
    
    'Рисуем прямоугольник вокруг поля
    rpt.ForeColor = RGB(255, 0, 0) 'Назначаем цвет
    rpt.Line (x0, 0)-(x0 + myWidth, rpt.Height), , B 'Прямоугольник
End Function

'===============================================================
' Закрываем запрос отчета
Private Sub Report_Close()
    rstRpt.Close
End Sub

10. Этот пример показывает, как можно добавить в отчет текст, например, комментарий расположенный не в таблице, а некотором месте.

Private Sub ОбластьДанных_Print(Cancel As Integer, PrintCount As Integer)
    funDrawText Me, 2700, "Наименование", "Распродажа" 'Добавляем в ячейку текст
    funDrawText Me, 50, "Цена", "Новая" 'Добавляем в ячейку текст
End Sub

'===============================================================
' Рисуем в поле текст strCaption в соответствии с условием
'
Private Function funDrawText(rpt As Report, pos As Single, strField As String, strCaption) As Long
Dim c As Control, h As Integer
        Set c = rpt.Section(acDetail).Controls(strField)
        h = rpt.FontSize 'Начальная высота шрифта
        If c  30 Then 'Условие для поля
            rpt.ScaleMode = 1 'Назначаем масштаб в твипах
            rpt.FontName = c.FontName  'Назначаем шрифт ячейки
            rpt.FontSize = 7  'Назначаем высоту текста
            rpt.ForeColor = RGB(255, 0, 0) 'Назначаем цвет
            rpt.CurrentX = pos + c.Left 'x координата текста в твипах
            rpt.CurrentY = 0 'y координата текста
            rpt.Print strCaption 'Печататем текст
        End If
        'Пример другого поля
        If strField = "Наименование" Then
            rpt.FontSize = 7  'Назначаем высоту текста
            rpt.ForeColor = RGB(0, 0, 255) 'Назначаем цвет
            rpt.CurrentX = pos + c.Left 'x координата текста в твипах
            rpt.Print strCaption 'Печататем текст
        End If
        
        rpt.FontSize = h 'Возвращаем размер шрифта для отчета
End Function

Когда Вам надо сгруппировать записи в запросах, например, найти сумму в колонке таблицы, то используйте вместе SELECT ключевое слово GROUP BY

-- Использование группировки
SELECT First(Книга) as Книги, avg(СуммаРуб) as [Средняя Цена] FROM [Данные] GROUP BY Книга

-- Выборка после группировки
SELECT First(Книга) as Книги, Avg(СуммаРуб) as [Средняя Цена] FROM [Данные] GROUP BY Книга 
HAVING Avg(СуммаРуб)350

Использование встроенных запросов итогда бывает оправданным, если у Вас нет временных таюлиц. Хотя для больших и перегруженных информацией баз данных использование их не рекомендуется. В общем применяйте такие запросы без сортировки, тогда скорость их выполнения будет высокой.

SELECT Данные.Дата, Данные.КурсUSD, 
  (select count(*) from [Данные]) AS ЧислоКниг FROM 
            Данные, Данные AS Данные_1, [Пример 01];

09. Программа построения табличных отчетов от Microsoft составлена так, что п��и изменении данных (1 строка, 2 строки) они могут не отображаться, т.к. в конструкторе эта высота уазывается жестко. Этот метод позволяет Вам обойти недостаток модуля отчетов от Microsoft и строить таблицы разной высоты.

Private Sub ОбластьДанных_Print(Cancel As Integer, PrintCount As Integer)
Dim h As Single
    h = funGetHeight(Me.Section(acDetail)) 'Опредеяем высоту строки
    funDrawBox Me, h, 1 'Оформляем секцию с толщиной линий = 1
End Sub

'===============================================================
' Расчет высоты строки в секции в зависимости от форматирования
' поля отчета, например, TextBox
'
Private Function funGetHeight(sec As Section) As Single
Dim c As Control
     funGetHeight = 0 'назначаем высоту ячейки
     For Each c In sec.Controls 'Просматриваем все поля отчета
         If funGetHeight  c.Height Then _
            funGetHeight = c.Height 'Возвращаем максимальную высоту
     Next c 'Следующее поле
End Function

'===============================================================
' Перед началом печати рисуем для каждого поля прямоугольник
'
Private Sub funDrawBox(rpt As Report, h As Single, w As Integer)
Dim c As Control
     rpt.DrawWidth = w 'Толщина линии
     'Красный цвет прямоугольника
     rpt.ForeColor = RGB(255, 0, 0) 'RED, GREEN, BLUE
     'Просматриваем все поля отчета
     For Each c In rpt.Section(acDetail).Controls
         rpt.Line (c.Left, c.Top)-(c.Left + c.width, h), , B 'Прямоугольник
     Next c
End Sub

Format встроенная функция в VBA, имеет много возможностей для форматирования различных данных типа дата, число и т.п. Применяется она только в mdb файлах. Для adp проектов ее использовать нельзя.

-- Форматирование даты
SELECT Продукт, Цена, Format(Now(),'YYYY-MM-DD') as ДатаЗаказа FROM Продукты;

-- Форматирование цен
SELECT *, "USD="  Format([СуммаРуб]/[КурсUSD],"0.00") as [СуммаUSD] FROM [Данные];

DESC - сортирует записи по убыванию, а ASC по возрастанию. Как будут сортироваться записи зависит и от настроек самой базы.

-- Сортировка по возрастанию и убыванию
SELECT * FROM [Данные] ORDER BY [СуммаРуб] ASC, [КурсUSD] DESC;