Элементы формы - Расширение стобцов пропорционально ширине формы (ленточной)

"Красиво" ресайзим контролли под тек. размер формы.
употребимо при развороте формы в полный экран или при разрешеении юсеру "ресайзить" форму.



MSA 2003 SP1 1280x1024 (в полный экран):

MSA 2003 SP1 1280x1024 (нормальное окно):

MSA 2010 1920x1200 (в полный экран):

КОД ИЗ ПРИМЕРА:
Главная форма:

Private Sub Form_Load()
'В полный экран :
    DoCmd.Maximize
End Sub

Private Sub Form_Resize()
'es 24.12.2012
'Событие - Изменение размеров формы
'--------------------------------------------------------------------------
'Перемещаем обьекты за именяемой формой
'Используем: object.Move left, top, width, height
'--------------------------------------------------------------------------
Const cm = 567   'Скока Твипов (Twips) в 1 см

Dim iMinFormWidth As Integer   'Мин. допустимая ширина и высота формы
Dim iMinFormHeight As Integer

Dim iNewFormWidth As Integer   'Новая ширина и высота формы
Dim iNewFormHeight As Integer

Dim l As Integer      'отступ слева
Dim t As Integer      'отступ сверху
Dim w As Integer      'ширина
Dim h As Integer      'высота
Dim iMid As Integer   'Середина формы
Dim iTemp As Integer  'Служебная для разл. расчётов
'--------------------------------------------------------------------------
On Error GoTo Form_ResizeErr
'
    iMinFormWidth = 23 * cm    'Мин. допустимая ширина формы
    iMinFormHeight = 10 * cm   'Мин. допустимая высота формы
    
    iNewFormWidth = Me.InsideWidth
    iNewFormHeight = Me.InsideHeight

'--------------------------------------------------------------------------
'                                  КОТРОЛИ:
'--------------------------------------------------------------------------
'Заголовок
    iTemp = Me!lblHeeader.Left
    Me!lblHeeader.Width = iNewFormWidth - iTemp 'По размеру и с одинаковым отступом по краям
'Фон Заголовка формы
    Me!imgFormHeaderFon.Width = iNewFormWidth
    
'Поле поиска
    iMid = Round(iNewFormWidth / 2, 0)
    iTemp = Round(Me!txtTextToSearch.Width / 2, 0)
    t = Me!txtTextToSearch.Top   ' Отступ сверху контрола
    l = iMid - iTemp             ' по центру
    w = Me!txtTextToSearch.Width
    h = Me!txtTextToSearch.Height
    Me!txtTextToSearch.Move l, t, w, h
'Лейбл (подпись) поиска
    w = Me!lblTextToSearch.Width
    l = l - Round(2 * cm, 0)
    Me!lblTextToSearch.Move l, t, w, h

'Кнопка очистки фильтра - cmdClearSearch относит. txtTextToSearch
    l = Me!txtTextToSearch.Left + Me!txtTextToSearch.Width + 60
    w = cmdClearSearch.Width
    Me!cmdClearSearch.Move l, t, w, h
   
   
'Кнопка "Закрыть" - Просто загоняем её в правый угол с отступом справа
    l = iNewFormWidth - Me!cmdClose.Width - 100
    Me!cmdClose.Left = l

'Фон "Подвала"
    Me!imgFormFooterFon.Width = iNewFormWidth

'Лейбл: Для перхода к полю поиска... - ПО ЦЕНТРУ
    iTemp = Round(Me!lblTabToS.Width / 2, 0)
    l = iMid - iTemp       ' по центру
    Me!lblTabToS.Left = l

'Объект = Подчинённая форма = Me!objSubForm
' - Объекты подчинённой обрабатываються в её собственном модуле
    l = 0
    t = Me!objSubForm.Top    'Отступ сверху
    w = iNewFormWidth        'Ширина
    'Получаем высоту подчинённой
    iTemp = Me.objFormHeader.Height + Me.objFormFooter.Height + t
    h = iNewFormHeight - iTemp
    Me!objSubForm.Move l, t, w, h

Form_ResizeBye:
    Exit Sub

Form_ResizeErr:
    If Err = 2100 Then 'Сворачивание
        Err.Clear
        'Debug.Print Err.Description
    Else
        MsgBox "Error " & Err.Number & " (" & Err.Description & ")" & vbCrLf & _
        "in procedure Form_Resize ", vbCritical, "Error!"
    End If
    Resume Form_ResizeBye
End Sub

Подчинённая форма:

Private Sub Form_Resize()
'Событие - Изменение размеров формы
'es - 24.12.2012
'--------------------------------------------------------------------
Const cm = 567   'Сколько Твипов (Twips) в 1 см '567 твипов = 1 см ' 1440 твипов = 1 дюйм
Dim iNewFormWidth As Integer 'Новая ширина формы (Всегда больше минимальной)
Dim xPlus As Integer
Dim wPlus As Integer
Dim l As Integer 'Отступ слева
Dim w As Integer 'Ширина

'Мин. допустимая ширина формы
Dim iMinFormWidth As Integer: iMinFormWidth = CInt(19 * cm)
'Начальная (минимальная) ширина полей в подчинённой форме
'Размеры берём в конструкторе формы
Dim iTypeNameWidth As Integer:        iTypeNameWidth = CInt(3 * cm)
Dim iManNameWidth As Integer:         iManNameWidth = CInt(4 * cm)
Dim iGoodNameWidth As Integer:        iGoodNameWidth = CInt(6 * cm)
Dim iGoodDescriptionWidth As Integer: iGoodDescriptionWidth = CInt(4 * cm)
'--------------------------------------------------------------------

On Error GoTo Form_Resize_Err

'Определяем новый размер формы
    w = Me.CurrentSectionLeft       ' Ширина области выделения формы
    iNewFormWidth = Me.InsideWidth - w  ' Чистая ширина формы

'Форма не может быть меньше минимального размера
    If iNewFormWidth <= iMinFormWidth Then GoTo Form_Resize_Bye

'Теперь обьекты формы
    With Me
        xPlus = iNewFormWidth - iMinFormWidth 'Получили тек прирост ширины формы
    
        If xPlus > 4 Then
            'Делим добавку ширины на 4 поля поровну
            wPlus = CInt(xPlus / 4) 'Прирост ширины для одного поля
        Else
            wPlus = 0
        End If

'Переставляем обьекты
'--------------------------------------------------------------------
    
    '00 - Линия
        w = iNewFormWidth - !UnderLine.Left
        !UnderLine.Width = w  'Линию подчёркивания по ширине
    
    '01 Поле "Тип ТОВАРА"
        l = !txtTypeName.Left 'Отступ не трогаем
        w = iTypeNameWidth + wPlus 'Нов ширина
        !txtTypeName.Left = l
        !txtTypeName.Width = w
        'Лейбл
        !lblTypeName.Left = l
        !lblTypeName.Width = w
    
    '02- Производитель
        l = l + w   'Отступ слева:l и ширина:w уже расчитаны выше
        w = iManNameWidth + wPlus 'Нов ширина
        !txtManName.Left = l
        !txtManName.Width = w
        
        'Лебл - туда же!
        !lblManName.Left = l
        !lblManName.Width = w
    
    '03 Наменование (полностью аналогично)
        l = l + w
        w = iGoodNameWidth + wPlus 'Нов ширина
        !txtGoodName.Left = l
        !txtGoodName.Width = w
        
        !lblGoodName.Left = l 'Лейбл
        !lblGoodName.Width = w
    
    '04 - Цена - просто передвигаем
        l = l + w
        w = !txtGoodPrice.Width 'Ширина = без изменений
        !txtGoodPrice.Left = l
        !txtGoodPrice.Width = w
        
        !lblGoodPrice.Left = l 'Лейбл
        !lblGoodPrice.Width = w
    
    '05- Описание Товара - по остаточному принципу (поправка на округление значения прироста ширины)
        l = l + w
        w = iNewFormWidth - l
        w = w - 4 ' Для чёткого отображения правой границы: уменьшаю ширину на n твипов
        !txtGoodDescription.Left = l
        !txtGoodDescription.Width = w
        
        !lblGoodDescription.Left = l 'Лейбл
        !lblGoodDescription.Width = w
    End With

Form_Resize_Bye:
    Exit Sub

Form_Resize_Err:

    Debug.Print "Error " & Err.Number & vbCrLf & Err.Description & vbCrLf & _
    "in procedure Form_Resize"
    Resume Form_Resize_Bye
End Sub

MSA-2003 ( 123 kB)