VBA, MS Access MS Access в примерах

Создание в отчетах таблиц с изменяемой высотой строк.

Public Sub DrawTableInDetailSection(objReportSection As Section, Optional lColor&)
'--------------------------------------------------------------------------
'es 01.06.2016 - 08.12.2017 L.E.
'Для "красивого" обрамления в таблицу области данных табличного
'отчета c изменяемой высотой полей (и соответственно строк целиком).
'Аргументы:
'   objReportSection = Ссылка на область данных отчета
'   lColor           = Цвет (По умолчанию = 0 чёрный)
'--------------------------------------------------------------------------
' "Вешается" на событие PRINT области данных отчета - например так:
'     Call DrawTableInDetailSection(Me.ОбластьДанных)
'--------------------------------------------------------------------------
'Дополнительно необходимо:
'    Контуры полей в области данных отчета должны быть невидимы
'    Свойство полей в области данных отчета: Can Grow (Расширение) - должно быть = True (для "вырастания" по высоте)
'--------------------------------------------------------------------------
'https://msdn.microsoft.com/en-us/library/office/ff198297.aspx
'--------------------------------------------------------------------------
Dim DataControl As Control    'обьект текущ. контроль
Dim x As Integer
Dim MaxHeight As Integer      'макс. высота в тек строке
Dim MinX As Integer           'координата начала горизонтальной линии
Dim MaxX As Integer           'координата конца горизонтальной линии
Dim StartX As Integer         'координата начала линии по оси X
Dim EndX As Integer           'координата конца линии по оси X
Dim StartY As Integer         'координата начала линии по оси Y
Dim EndY As Integer           'координата конца линии по оси Y

On Error GoTo DrawTableInDetailSectionERR
    MaxX = 0
    MinX = 0
    With objReportSection
        'Для начала - находим контрол с макс высотой (в области данных)
        'и max ширину попутно
            For Each DataControl In .Controls
                x = DataControl.Height
                If MaxHeight < x Then MaxHeight = x
                
                x = DataControl.Left + DataControl.Width
                If MaxX < x Then MaxX = x
                
                x = DataControl.Left
                If MinX > x Then MinX = x
            Next
        'рисуем вертикальную в Начале строки
            EndY = MaxHeight
            .Parent.Line (MinX, StartY)-(MinX, EndY), lColor
        'рисуем горизонтальную над строкой (если нужно)
        '    .Parent.Line (MinX, StartY)-(MaxX, StartY), lColor
        'рисуем горизонтальную под строкой (подчёркивание сразу всей строки)
            .Parent.Line (MinX, EndY)-(MaxX, EndY), lColor
        
        'теперь рисуем вертикальные линии справа от каждого контрола
            For Each DataControl In .Controls
                StartX = DataControl.Left + DataControl.Width
                EndX = StartX
                .Parent.Line (StartX, StartY)-(StartX, EndY), lColor
            Next
            
    End With
    Exit Sub

DrawTableInDetailSectionERR:
    'Debug.Print Err.Description
    Err.Clear
End Sub


Назад ToTop
L.E. 20.01.2024
Рейтинг@Mail.ru