Skip to main content

Универсальный автоподбор высоты ленточной формы Access

1. Общая идея

Для любой ленточной формы высота окна считается по формуле:

Высота формы = (N + ExtraRows) × RowHeightCm + ExtraHeightCm

где:

N             — текущее количество записей формы с учётом фильтра;
ExtraRows     — временная добавка строк, например при добавлении новой записи;
RowHeightCm   — высота одной строки ленточной формы;
ExtraHeightCm — запас на заголовок, кнопки, шапку таблицы, рамки и нижний отступ.

Например:

Высота строки = 0,529 см
Дополнительная высота = 4 см
Количество строк = 5

Высота формы = 5 × 0,529 + 4 = 6,645 см

2. Создай стандартный модуль

В Access:

Создание → Модуль

Сохрани модуль с именем:

mContinuousFormAutoHeight

Это должен быть обычный стандартный модуль, не модуль формы.

3. Вставь универсальный код модуля

В модуль mContinuousFormAutoHeight вставь полностью:

Option Compare Database
Option Explicit

' ============================================================
' УНИВЕРСАЛЬНЫЙ МОДУЛЬ АВТОПОДБОРА ВЫСОТЫ ЛЕНТОЧНОЙ ФОРМЫ
'
' Назначение:
'   Автоматически изменяет высоту окна ленточной формы
'   в зависимости от количества текущих записей.
'
' Основная формула:
'
'   Высота = (N + ExtraRows) * RowHeightCm + ExtraHeightCm
'
' где:
'   N             - количество текущих записей формы с учётом фильтра;
'   ExtraRows     - дополнительное количество строк для расчёта;
'   RowHeightCm   - высота одной строки ленточной части в сантиметрах;
'   ExtraHeightCm - дополнительная высота окна формы в сантиметрах.
'
' ------------------------------------------------------------
' Расшифровка параметров AutoFitContinuousFormHeight:
' ------------------------------------------------------------
'
' frm As Access.Form
'   Форма, для которой выполняется автоподбор высоты.
'   Обычно передаётся текущая форма:
'
'       frm:=Me
'
'
' ExtraRows As Long
'   Дополнительное количество строк, которое временно прибавляется
'   к фактическому количеству записей.
'
'   Примеры:
'       ExtraRows:=0   - считать только сохранённые записи;
'       ExtraRows:=1   - прибавить одну временную строку;
'       ExtraRows:=-1  - уменьшить расчёт на одну строку.
'
'   Основной сценарий:
'       при начале добавления новой записи в ленточной форме
'       вызываем автоподбор с ExtraRows:=1.
'
'
' RowHeightCm As Double
'   Высота одной строки ленточной формы в сантиметрах.
'
'   Если UseDetailSectionHeight:=True, то этот параметр можно не задавать:
'   модуль сам возьмёт высоту строки из секции Detail формы.
'
'   Если UseDetailSectionHeight:=False, тогда RowHeightCm нужно задать вручную.
'
'   Пример:
'       RowHeightCm:=0.529
'
'
' ExtraHeightCm As Double
'   Дополнительная высота формы в сантиметрах.
'
'   В неё обычно входит:
'       - заголовок формы;
'       - верхняя область с кнопками;
'       - заголовки столбцов;
'       - нижний отступ;
'       - рамки окна;
'       - небольшой запас по высоте.
'
'   Пример:
'       ExtraHeightCm:=4
'
'
' MinRows As Long
'   Минимальное количество строк, которое форма должна учитывать.
'
'   Пример:
'       MinRows:=3
'
'   Даже если записей 0 или 1, форма будет иметь высоту
'   минимум как для 3 строк.
'
'   Если MinRows:=0, ограничение не применяется.
'
'
' MaxRows As Long
'   Максимальное количество строк, которое форма должна учитывать.
'
'   Пример:
'       MaxRows:=15
'
'   Даже если записей 30, высота будет рассчитана максимум
'   как для 15 строк.
'
'   Если MaxRows:=0, ограничение не применяется.
'
'   Важно:
'       если используешь MaxRows, у формы лучше включить
'       вертикальную полосу прокрутки.
'
'
' MinHeightCm As Double
'   Минимальная итоговая высота окна формы в сантиметрах.
'
'   Применяется уже после расчёта по строкам.
'
'   Пример:
'       MinHeightCm:=6
'
'   Если расчётная высота меньше 6 см,
'   будет применено 6 см.
'
'   Если MinHeightCm:=0, ограничение не применяется.
'
'
' MaxHeightCm As Double
'   Максимальная итоговая высота окна формы в сантиметрах.
'
'   Применяется уже после расчёта по строкам.
'
'   Пример:
'       MaxHeightCm:=18
'
'   Если расчётная высота больше 18 см,
'   будет применено 18 см.
'
'   Если MaxHeightCm:=0, ограничение не применяется.
'
'
' WidthCm As Double
'   Ширина окна формы в сантиметрах.
'
'   Если WidthCm > 0, процедура изменит не только высоту,
'   но и ширину окна формы.
'
'   Пример:
'       WidthCm:=20
'
'   Если WidthCm:=0, ширина формы не изменяется.
'
'
' IncludeNewRowIfAllowed As Boolean
'   Учитывать ли стандартную пустую строку добавления Access.
'
'   Если True и у формы AllowAdditions=True,
'   к расчёту будет добавлена ещё одна строка.
'
'   Если False, учитываются только фактические записи
'   плюс значение ExtraRows.
'
'   Обычно удобнее использовать:
'       IncludeNewRowIfAllowed:=False
'
'   А при начале добавления строки вручную вызывать:
'       ExtraRows:=1
'
'
' UseDetailSectionHeight As Boolean
'   Использовать ли фактическую высоту секции Detail формы
'   как высоту одной строки.
'
'   Если True:
'       высота строки берётся автоматически из формы.
'
'   Если False:
'       используется значение RowHeightCm.
'
'   Для универсального применения обычно удобно:
'       UseDetailSectionHeight:=True
'
'
' ActivateFormBeforeResize As Boolean
'   Активировать ли форму перед изменением размера окна.
'
'   Обычно не требуется, если процедура вызывается из событий
'   этой же формы.
'
'   Рекомендуемое значение:
'       ActivateFormBeforeResize:=False
'
'   Можно поставить True, если процедура вызывается извне
'   и есть риск, что активным является другое окно.
'
'
' PrintDebugInfo As Boolean
'   Выводить ли отладочную информацию в Immediate Window VBA.
'
'   Если True, в окно отладки будет выведено:
'       - имя формы;
'       - количество записей;
'       - количество строк для расчёта;
'       - высота строки;
'       - дополнительная высота;
'       - итоговая высота в см;
'       - итоговая высота в твипах.
'
'   Открыть Immediate Window можно сочетанием:
'       Ctrl + G
'
'
' ShowErrors As Boolean
'   Показывать ли сообщение об ошибке при сбое автоподбора высоты.
'
'   Если True:
'       пользователь увидит MsgBox с текстом ошибки.
'
'   Если False:
'       ошибка будет подавлена.
'
'
' ------------------------------------------------------------
' Важно:
' ------------------------------------------------------------
'
'   DoCmd.MoveSize изменяет размер активного окна Access.
'   Поэтому процедуру желательно вызывать из событий той формы,
'   которую нужно изменить.
'
'   Модуль рассчитан на отдельные формы, открытые как окно.
'   Для подчинённых форм внутри другой формы этот способ напрямую
'   не меняет размер элемента подчинённой формы.
'
'   Размеры в DoCmd.MoveSize задаются в твипах.
'   Внутри модуля сантиметры автоматически переводятся в твипы.
'
'   1 см примерно равен 567 твипам.
'
' ============================================================


' ------------------------------------------------------------
' Базовые настройки по умолчанию
' ------------------------------------------------------------
Private Const CFAH_TWIPS_PER_CM As Double = 567
Private Const CFAH_DEFAULT_ROW_HEIGHT_CM As Double = 0.529
Private Const CFAH_DEFAULT_EXTRA_HEIGHT_CM As Double = 4


' ------------------------------------------------------------
' Основная универсальная процедура автоподбора высоты формы
' ------------------------------------------------------------
Public Sub AutoFitContinuousFormHeight( _
    ByVal frm As Access.Form, _
    Optional ByVal ExtraRows As Long = 0, _
    Optional ByVal RowHeightCm As Double = -1, _
    Optional ByVal ExtraHeightCm As Double = -1, _
    Optional ByVal MinRows As Long = 0, _
    Optional ByVal MaxRows As Long = 0, _
    Optional ByVal MinHeightCm As Double = 0, _
    Optional ByVal MaxHeightCm As Double = 0, _
    Optional ByVal WidthCm As Double = 0, _
    Optional ByVal IncludeNewRowIfAllowed As Boolean = False, _
    Optional ByVal UseDetailSectionHeight As Boolean = True, _
    Optional ByVal ActivateFormBeforeResize As Boolean = False, _
    Optional ByVal PrintDebugInfo As Boolean = False, _
    Optional ByVal ShowErrors As Boolean = True)

    On Error GoTo ErrHandler

    Dim recordsCount As Long
    Dim rowsCountForHeight As Long

    Dim effectiveRowHeightCm As Double
    Dim targetHeightCm As Double
    Dim targetHeightTwips As Long
    Dim targetWidthTwips As Long

    ' Если форма не передана — выходим
    If frm Is Nothing Then Exit Sub

    ' Определяем высоту одной строки
    If UseDetailSectionHeight = True Then

        ' Берём высоту секции Detail формы.
        ' Это самый универсальный вариант для ленточных форм.
        effectiveRowHeightCm = TwipsToCm(frm.Section(acDetail).Height)

        ' Если по какой-то причине высота не определилась,
        ' используем ручной параметр или значение по умолчанию.
        If effectiveRowHeightCm <= 0 Then

            If RowHeightCm > 0 Then
                effectiveRowHeightCm = RowHeightCm
            Else
                effectiveRowHeightCm = CFAH_DEFAULT_ROW_HEIGHT_CM
            End If

        End If

    Else

        ' Используем высоту строки, переданную вручную
        If RowHeightCm > 0 Then
            effectiveRowHeightCm = RowHeightCm
        Else
            effectiveRowHeightCm = CFAH_DEFAULT_ROW_HEIGHT_CM
        End If

    End If

    ' Если дополнительная высота не задана — берём значение по умолчанию
    If ExtraHeightCm < 0 Then
        ExtraHeightCm = CFAH_DEFAULT_EXTRA_HEIGHT_CM
    End If

    ' Получаем количество текущих записей формы с учётом фильтра
    recordsCount = GetContinuousFormRecordsCount(frm)

    ' Основное количество строк для расчёта
    rowsCountForHeight = recordsCount + ExtraRows

    ' Если нужно учитывать стандартную пустую строку добавления Access
    If IncludeNewRowIfAllowed = True Then

        If frm.AllowAdditions = True Then
            rowsCountForHeight = rowsCountForHeight + 1
        End If

    End If

    ' Защита от отрицательного количества строк
    If rowsCountForHeight < 0 Then
        rowsCountForHeight = 0
    End If

    ' Минимальное количество строк
    If MinRows > 0 Then

        If rowsCountForHeight < MinRows Then
            rowsCountForHeight = MinRows
        End If

    End If

    ' Максимальное количество строк
    If MaxRows > 0 Then

        If rowsCountForHeight > MaxRows Then
            rowsCountForHeight = MaxRows
        End If

    End If

    ' Считаем высоту в сантиметрах
    targetHeightCm = rowsCountForHeight * effectiveRowHeightCm + ExtraHeightCm

    ' Минимальная высота формы в сантиметрах
    If MinHeightCm > 0 Then

        If targetHeightCm < MinHeightCm Then
            targetHeightCm = MinHeightCm
        End If

    End If

    ' Максимальная высота формы в сантиметрах
    If MaxHeightCm > 0 Then

        If targetHeightCm > MaxHeightCm Then
            targetHeightCm = MaxHeightCm
        End If

    End If

    ' Переводим высоту в твипы
    targetHeightTwips = CmToTwips(targetHeightCm)

    ' Защита от нулевой высоты
    If targetHeightTwips < 1 Then
        targetHeightTwips = 1
    End If

    ' При необходимости активируем форму перед изменением размера
    If ActivateFormBeforeResize = True Then

        DoCmd.SelectObject acForm, frm.Name, False

    End If

    ' Если задана ширина — меняем и ширину, и высоту
    If WidthCm > 0 Then

        targetWidthTwips = CmToTwips(WidthCm)

        DoCmd.MoveSize , , targetWidthTwips, targetHeightTwips

    Else

        ' Если ширина не задана — меняем только высоту
        DoCmd.MoveSize , , , targetHeightTwips

    End If

    ' Отладочный вывод в Immediate Window
    If PrintDebugInfo = True Then

        Debug.Print "AutoFitContinuousFormHeight"
        Debug.Print "Form: " & frm.Name
        Debug.Print "Records: " & recordsCount
        Debug.Print "ExtraRows: " & ExtraRows
        Debug.Print "RowsForHeight: " & rowsCountForHeight
        Debug.Print "UseDetailSectionHeight: " & UseDetailSectionHeight
        Debug.Print "EffectiveRowHeightCm: " & effectiveRowHeightCm
        Debug.Print "ExtraHeightCm: " & ExtraHeightCm
        Debug.Print "TargetHeightCm: " & targetHeightCm
        Debug.Print "TargetHeightTwips: " & targetHeightTwips
        Debug.Print String(40, "-")

    End If

    Exit Sub

ErrHandler:

    If ShowErrors = True Then

        MsgBox "Ошибка при автоподборе высоты формы:" & vbCrLf & _
               Err.Number & " - " & Err.Description, _
               vbExclamation, "Автоподбор высоты формы"

    End If

End Sub


' ------------------------------------------------------------
' Получение количества текущих записей формы
' Учитывает текущий фильтр формы
' ------------------------------------------------------------
Public Function GetContinuousFormRecordsCount(ByVal frm As Access.Form) As Long

    On Error GoTo ErrHandler

    Dim rs As Object

    If frm Is Nothing Then

        GetContinuousFormRecordsCount = 0

        Exit Function

    End If

    Set rs = frm.RecordsetClone

    ' Если записей нет
    If rs.BOF And rs.EOF Then

        GetContinuousFormRecordsCount = 0

    Else

        ' Для корректного RecordCount нужно перейти в конец набора
        rs.MoveLast

        GetContinuousFormRecordsCount = rs.RecordCount

    End If

    rs.Close
    Set rs = Nothing

    Exit Function

ErrHandler:

    GetContinuousFormRecordsCount = 0

End Function


' ------------------------------------------------------------
' Перевод сантиметров в твипы
' ------------------------------------------------------------
Public Function CmToTwips(ByVal valueCm As Double) As Long

    CmToTwips = CLng(valueCm * CFAH_TWIPS_PER_CM)

End Function


' ------------------------------------------------------------
' Перевод твипов в сантиметры
' Может пригодиться для отладки
' ------------------------------------------------------------
Public Function TwipsToCm(ByVal valueTwips As Long) As Double

    TwipsToCm = valueTwips / CFAH_TWIPS_PER_CM

End Function

4. Как подключать к любой ленточной форме

В модуле конкретной формы нужно создать маленькую локальную процедуру-обёртку.

Например:

' ------------------------------------------------------------
' Локальная процедура автоподбора высоты текущей формы
' ------------------------------------------------------------
Private Sub FitCurrentFormHeight(Optional ByVal ExtraRows As Long = 0)

    Call AutoFitContinuousFormHeight( _
        frm:=Me, _
        ExtraRows:=ExtraRows, _
        RowHeightCm:=-1, _
        ExtraHeightCm:=4, _
        MinRows:=0, _
        MaxRows:=0, _
        MinHeightCm:=0, _
        MaxHeightCm:=0, _
        WidthCm:=0, _
        IncludeNewRowIfAllowed:=False, _
        UseDetailSectionHeight:=True, _
        ActivateFormBeforeResize:=False, _
        PrintDebugInfo:=False, _
        ShowErrors:=True)

End Sub

В этом варианте:

UseDetailSectionHeight:=True

означает, что высота одной строки берётся автоматически из секции Detail / Область данных текущей формы.

Если нужно вручную задать высоту строки, например 0,529 см, тогда используй так:

Private Sub FitCurrentFormHeight(Optional ByVal ExtraRows As Long = 0)

    Call AutoFitContinuousFormHeight( _
        frm:=Me, _
        ExtraRows:=ExtraRows, _
        RowHeightCm:=0.529, _
        ExtraHeightCm:=4, _
        MinRows:=0, _
        MaxRows:=0, _
        MinHeightCm:=0, _
        MaxHeightCm:=0, _
        WidthCm:=0, _
        IncludeNewRowIfAllowed:=False, _
        UseDetailSectionHeight:=False, _
        ActivateFormBeforeResize:=False, _
        PrintDebugInfo:=False, _
        ShowErrors:=True)

End Sub

5. Где вызывать автоподбор высоты

5.1. При загрузке формы

В модуле формы:

Private Sub Form_Load()

    Call FitCurrentFormHeight

End Sub

5.2. После применения фильтра

Если на форме есть фильтрация, то после изменения фильтра вызывай:

Call FitCurrentFormHeight

Пример:

Private Sub ApplyCurrentFilter()

    ' Здесь пример фильтра.
    ' Условие фильтра нужно заменить на своё.
    Me.Filter = "[Поле] = 'Значение'"
    Me.FilterOn = True

    ' После фильтрации пересчитываем высоту формы
    Call FitCurrentFormHeight

End Sub

5.3. При начале добавления новой записи

В событии формы Перед вставкой:

Private Sub Form_BeforeInsert(Cancel As Integer)

    ' Так как пользователь начал ввод новой строки,
    ' временно увеличиваем высоту формы на одну строку
    Call FitCurrentFormHeight(1)

End Sub

Это нужно для того, чтобы форма расширялась сразу при появлении новой строки, а не только после сохранения записи.

5.4. После сохранения новой записи

В событии формы После вставки:

Private Sub Form_AfterInsert()

    ' После сохранения записи пересчитываем высоту уже по фактическому количеству строк
    Call FitCurrentFormHeight

End Sub

5.5. После удаления записи

В событии формы После подтверждения удаления:

Private Sub Form_AfterDelConfirm(Status As Integer)

    If Status = acDeleteOK Then

        ' После удаления строки пересчитываем высоту формы
        Call FitCurrentFormHeight

    End If

End Sub

Если удаление выполняется своей кнопкой через DELETE FROM ..., тогда после удаления тоже нужно вызвать:

Call FitCurrentFormHeight

или вызвать свою процедуру фильтрации, если она внутри уже делает автоподбор.

6. Рекомендуемые свойства формы

Для формы, к которой применяется автоподбор, желательно проверить:

Режим по умолчанию: Ленточная форма
Всплывающее окно: Да
Автоцентр: Да
Авторазмер: Нет
Разрешить добавление: Да/Нет — по задаче
Разрешить изменение: Да/Нет — по задаче
Разрешить удаление: Да/Нет — по задаче

Если используешь ограничения:

MaxRows:=10

или:

MaxHeightCm:=15

то лучше включить вертикальную прокрутку:

Полосы прокрутки: Вертикальная

Иначе часть строк может оказаться ниже видимой области.

7. Типовые настройки

Вариант 1. Полностью автоматическая высота строки

Private Sub FitCurrentFormHeight(Optional ByVal ExtraRows As Long = 0)

    Call AutoFitContinuousFormHeight( _
        frm:=Me, _
        ExtraRows:=ExtraRows, _
        ExtraHeightCm:=4, _
        UseDetailSectionHeight:=True)

End Sub

Это самый универсальный вариант.

Вариант 2. Ручная высота строки

Private Sub FitCurrentFormHeight(Optional ByVal ExtraRows As Long = 0)

    Call AutoFitContinuousFormHeight( _
        frm:=Me, _
        ExtraRows:=ExtraRows, _
        RowHeightCm:=0.529, _
        ExtraHeightCm:=4, _
        UseDetailSectionHeight:=False)

End Sub

Такой вариант удобен, если ты заранее измерил высоту строки.

Вариант 3. Ограничить максимальную высоту

Private Sub FitCurrentFormHeight(Optional ByVal ExtraRows As Long = 0)

    Call AutoFitContinuousFormHeight( _
        frm:=Me, _
        ExtraRows:=ExtraRows, _
        ExtraHeightCm:=4, _
        MaxRows:=15, _
        MaxHeightCm:=18, _
        UseDetailSectionHeight:=True)

End Sub

Форма не будет расти бесконечно вверх/вниз, даже если записей много.

Вариант 4. Задать и высоту, и ширину формы

Private Sub FitCurrentFormHeight(Optional ByVal ExtraRows As Long = 0)

    Call AutoFitContinuousFormHeight( _
        frm:=Me, _
        ExtraRows:=ExtraRows, _
        ExtraHeightCm:=4, _
        WidthCm:=22, _
        UseDetailSectionHeight:=True)

End Sub

Если WidthCm:=0, ширина не меняется.

8. Минимальный комплект кода в каждой форме

Для каждой новой ленточной формы достаточно вставить в её модуль:

Private Sub Form_Load()

    Call FitCurrentFormHeight

End Sub


Private Sub Form_BeforeInsert(Cancel As Integer)

    Call FitCurrentFormHeight(1)

End Sub


Private Sub Form_AfterInsert()

    Call FitCurrentFormHeight

End Sub


Private Sub Form_AfterDelConfirm(Status As Integer)

    If Status = acDeleteOK Then
        Call FitCurrentFormHeight
    End If

End Sub


Private Sub FitCurrentFormHeight(Optional ByVal ExtraRows As Long = 0)

    Call AutoFitContinuousFormHeight( _
        frm:=Me, _
        ExtraRows:=ExtraRows, _
        ExtraHeightCm:=4, _
        UseDetailSectionHeight:=True)

End Sub

А если в форме есть фильтрация, после применения фильтра добавляешь:

Call FitCurrentFormHeight

9. Проверка работы

После подключения:

1. Открой ленточную форму.
2. Проверь, что высота окна стала соответствовать количеству строк.
3. Примени фильтр, если он есть.
4. Проверь, что высота пересчиталась после фильтрации.
5. Начни вводить новую строку.
6. Форма должна временно увеличиться на одну строку.
7. Сохрани новую строку.
8. Высота должна пересчитаться по фактическому количеству записей.
9. Удали строку.
10. Высота должна уменьшиться.

10. Практическое правило настройки

Сначала пробуй так:

UseDetailSectionHeight:=True
ExtraHeightCm:=4

Если форма получается слишком низкой — увеличивай:

ExtraHeightCm:=4.5

или:

ExtraHeightCm:=5

Если слишком высокой — уменьшай:

ExtraHeightCm:=3.5

То есть в большинстве случаев настраивать придётся только один параметр:

ExtraHeightCm
Back to top