Выравнивание Элементов Управления по центру при изменении размеров Формы

... то что должно быть по середине  - там и останется, не зависимо от изменений размеров формы ...

Внимание!
Свойство Элемента(ов) Horizontal Anchor должно быть устоновлено = Left (по умолчанию) - иначе результат будет не ожидаемым

Модуль:

Option Compare Database
Option Explicit

'--------------------------------------------------------------------
' Module    : modFormControlsToCenter
' Version   : 002
' Author    : es
' Date      : 02.08.2015 LE 25.05.2022
' Purpose   : Выравнивание контролий формы по центру при изменении её размеров
'             Используется на событии  на событии Form_Resize()
'             Две процедуры раздельного выравнивания:
'               ControlToCenterHz () - По горизонтали
'               ControlToCenterVr () - По вертикали
'--------------------------------------------------------------------
Private Const cm = 567             'Сколько Твипов (Twips) в 1 см
'--------------------------------------------------------------------
Private lLeft As Long              'Отступ слева обьекта
Private lTop As Long               'Отступ сверху обьекта
Private lWidth As Long             'Ширина обьекта
Private lHeight As Long            'Высота обьекта
Private iСorrectionTwips As Long   'Поправка в твипах
'--------------------------------------------------------------------

Public Sub ControlToCenterHz(frm As Form, ctrl As Control, Optional iMinFormWidthCm As Currency = 0, Optional iPlusMinusCm As Currency = 0)
'Выравнивание контрола по середине формы  (при изменении её размеров)
'--------------------------------------------------------------------
'Параметры:
'   ctrl             = Ссылка на перемещаемый контрол
'   frm              = Форма -  изменившая размеры
'   iMinFormWidthCm  = Минимальный размер формы (в САНТИМЕТРАХ) по горизонтали
'                      по достижению которого пердвижения не происходит
'   iPlusMinusCm     = поправка в см - Пожительное или Отрицательное значение (точность = 4 знака)
'                      (Для выравнивания нескольких обьектов) относительно горизонтального центра формы
'                      т.е. в сантиметрах от серидины формы ...
'--------------------------------------------------------------------
Dim iNewFormWidth As Long      'Новая ширина формы
Dim iLeftToFormMid As Long     'Отступ слева до середины формы
Dim lVal As Long                 'Служебная для разл. расчётов
'--------------------------------------------------------------------
On Error GoTo ControlToCenterHz_Err
   
'Новая ширина формы:
    iNewFormWidth = frm.InsideWidth
 
'Учёт минимальной высоты формы
    lVal = iMinFormWidthCm * cm + lVal
    If iNewFormWidth < lVal Then GoTo ControlToCenterHz_Bye
 
 
'Расчёт поправки в твипах
    iСorrectionTwips = Round(iPlusMinusCm * cm, 0)


'Отступ слева до Середины формы по горизонтали
    iLeftToFormMid = Round(iNewFormWidth / 2, 0)  'Центр формы по ширене
    
'--------------------------------------------------------------------
'Берём текущие параметры
    lTop = ctrl.Top    'Отступ сверху контрола
    lWidth = ctrl.Width  'Ширина контрола
    lHeight = ctrl.Height 'Высота контрола
    
' Расчёт отступа слева учётом поправки - см функцию "NewControlPositionInTwips" ниже ...
    lLeft = NewControlPositionInTwips(iLeftToFormMid, ctrl.Width, iСorrectionTwips)
    If lLeft < 0 Then GoTo ControlToCenterHz_Bye

'Собственно перемещение
    ctrl.Move lLeft, lTop, lWidth, lHeight


ControlToCenterHz_Bye:
    Exit Sub

ControlToCenterHz_Err:
    MsgBox "Ошибка " & Err.Number & vbCrLf & Err.Description & vbCrLf & _
    "в процедуре: ControlToCenterHz", vbCritical, "Error!"
    Resume ControlToCenterHz_Bye

End Sub

Public Sub ControlToCenterVr(frm As Form, ctrl As Control, Optional ByVal iMinFormHeightCm As Currency = 0, Optional ByVal iPlusMinusCm As Currency = 0)
'Выравнивание контрола по середине формы Вертикально (при изменении её размеров)
'--------------------------------------------------------------------
'Параметры:
'   frm               = Ссылка на Форму -  изменившую размеры
'   ctrl              = Ссылка на перемещаемый контрол
'   iMinFormHeightCm  = Минимальный размер формы (в САНТИМЕТРАХ) по вертикали
'                       по достижению которого передвижения не происходит!
'                       (с учётом заголовка и примечания формы - если они видимы)
'   iPlusMinusCm      = поправка в см - Пожительное или Отрицательное значение (точность = 4 знака)
'                       (Для выравнивания нескольких обьектов) относительно центра формы
'                       т.е. в сантиметрах от серидины формы ...
'--------------------------------------------------------------------
Dim iNewFormHeight As Long    'Новая высота формы
Dim iTopToFormMid As Long 'Отступ сверху до середины формы
Dim lVal As Long                 'Служебная для разл. расчётов
Dim lZLong As Long
'--------------------------------------------------------------------
On Error GoTo ControlToCenterVr_Err
    
'Новая высота формы:
    iNewFormHeight = frm.InsideHeight

'Учёт минимальной высоты формы
    lVal = iMinFormHeightCm * cm + lVal
    If iNewFormHeight < lVal Then GoTo ControlToCenterVr_Bye

'Расчёт поправки в твипах
    iСorrectionTwips = Round(iPlusMinusCm * cm, 0)
   
'Расчёт отступа сверху до Середины области данных формы
'--------------------------------------------------------------------
'Суммарная высота заголовка и примечания формы acHeader acFooter
    If FormHasSections(frm) = True Then 'См функцию "FormHasSections" ниже ...
        If frm.Section(acHeader).Visible = True Then lZLong = frm.Section(acHeader).Height     'Заголовок
        If frm.Section(acFooter).Visible = True Then lZLong = lZLong + frm.Section(acFooter).Height 'Примечание
    Else
        lZLong = 0
    End If
    
'Отступ сверху Середины области данных формы по высоте с учётом заголовка и примечания
    lVal = iNewFormHeight - lZLong                      'Высота области данных в твипах
    iTopToFormMid = Round(lVal / 2, 0)             'Отступ сверху до середины формы

'--------------------------------------------------------------------
'Берём тек параметры:
    lLeft = ctrl.Left   'Отступ лева контрола
    lWidth = ctrl.Width  'Ширина контрола
    lHeight = ctrl.Height 'Высота контрола

' Расчёт отступа сверху с учётом высоты контроля и поправочки
    lTop = NewControlPositionInTwips(iTopToFormMid, ctrl.Height, iСorrectionTwips)

'Собственно перемещение контрола
    ctrl.Move lLeft, lTop, lWidth, lHeight


ControlToCenterVr_Bye:
    Exit Sub

ControlToCenterVr_Err:
    MsgBox "Ошибка " & Err.Number & vbCrLf & Err.Description & vbCrLf & _
    "в процедуре: ControlToCenterVr", vbCritical, "Error!"
    Resume ControlToCenterVr_Bye
End Sub

Private Function FormHasSections(frm As Form) As Boolean
'Возвращает True если указанная в аргументе форма имеет Секции (Заголовок | Примечание)
'--------------------------------------------------------------------
Dim b As Boolean
'--------------------------------------------------------------------
On Error GoTo FormHasSections_Err
    b = frm.Section(acHeader).Visible
    FormHasSections = True
    Exit Function

FormHasSections_Err:
    FormHasSections = False 'Error 2462
    Err.Clear

End Function
Private Function NewControlPositionInTwips(iTwipsToFormMid As Long, iTwipsControlSize As Long, iPlusMinusTwips As Long) As Long
Dim lALong As Long                 'Служебная для разл. расчётов
Dim lZLong As Long
'--------------------------------------------------------------------
' Расчёт отступа сверху | слева с учётом размера контроля и поправочки
    lALong = iTwipsToFormMid + iPlusMinusTwips   ' Учли поправку
    lZLong = Round(iTwipsControlSize / 2, 0)     ' Половина размера обьекта
    lALong = lALong - lZLong
    If lALong < 0 Then lALong = 0 'На всякий случай ... (то превент еррорс...)
    NewControlPositionInTwips = lALong         '
End Function

Public Sub ControlsToCenterAutoCode(sFormName As String, Optional bForNotCurrentForm As Boolean = False, Optional curPlusMinusToTopCm As Currency)
' Выводит в Immadiate Window (Ctrl + G) код для перемещения обьектов указанной в аргументе формы
' На момент вывода форма должна быть в минимальном размере и  контроли должны быть выровнены как хочется
' Остальные расчёты  процедура сделает сама
'--------------------------------------------------------------------
' Аргументы:
'   sFormName             = Название формы
'   bForNotCurrentForm    = Для текущей формы или нет
'   curPlusMinusToTopCm   = Вертикальная поправка в см
'                         = Пожительное или Отрицательное значение (точность = 4 знака)
'--------------------------------------------------------------------
' Пример эксплуотации: ControlsToCenterAutoCode "FormTest", False
'--------------------------------------------------------------------
Dim iNewFormWidth As Long
Dim iNewFormHeight As Long    'Новая высота формы
Dim iToFormMidHz As Long         'Отступ слева до середины формы
Dim iToFormMidVr As Long         'Отступ сверху до середины формы
Dim iСorrectionTwips As Long   'Поправка в твипах
Dim frm As Form
Dim ctrl As Control
Dim sOne As String                'Служебная строка
Dim sTwo As String                'Служебная строка
Dim sFormLink As String           'Служебная строка
Dim cMinFormWidthCm As Currency   'Новая ширина формы в см
Dim cMinFormHeightCm As Currency  'Новая высота формы в см
Dim cСorrectionCm As Currency     'Поправка в см

Dim bIsLoaded As Boolean          'Загружена ли форма
Dim lVal As Long                 'Служебная для разл. расчётов
Dim cVal As Currency                 'Служебная для разл. расчётов
'--------------------------------------------------------------------
On Error GoTo ControlsToCenterAutoCode_Err
    
'Прверяем загружена ли форма
    For lVal = 0 To Forms.Count - 1
        If Forms(lVal).FormName = sFormName Then
            bIsLoaded = True
        End If
    Next

    If bIsLoaded = True Then DoCmd.Close acForm, sFormName, acSaveNo

    DoCmd.OpenForm sFormName, acDesign, "", "", , acHidden ' открываем форму в режиме Редакции
    Set frm = Forms(sFormName)

    
'Формируем ссылку на форму
    If bForNotCurrentForm = False Then
        sFormLink = "Me"
    Else
        sFormLink = "Forms(""" & frm.Name & """)"
    End If


'Ширина и высота формы:
    iNewFormWidth = frm.Width
    cMinFormWidthCm = Round(iNewFormWidth / cm, 4)
    iToFormMidHz = Round(iNewFormWidth / 2, 0) 'отступ слева до середины ФОРМЫ



'Суммарная высота заголовка и примечания формы acHeader acFooter
    If FormHasSections(frm) = True Then 'См функцию "FormHasSections" ниже ...
        If frm.Section(acHeader).Visible = True Then lVal = frm.Section(acHeader).Height     'Заголовок
        If frm.Section(acFooter).Visible = True Then lVal = lVal + frm.Section(acFooter).Height 'Примечание
    Else
        lVal = 0
    End If
    
    iNewFormHeight = frm.Section(0).Height + lVal
    cVal = Round(iNewFormHeight / cm, 2)
    cMinFormHeightCm = Round(cVal, 1)
    lVal = frm.Section(0).Height
    iToFormMidVr = Round(lVal / 2, 0) 'отступ сверху до середины ФОРМЫ
    
'Расчёт
    Debug.Print "'--------------------------------------------------------------------"
    Debug.Print "'Перемещение обьектов формы в центр:"
    Debug.Print "'(код автоматически создан процедурой ""ControlsToCenterAutoCode"" модуля ""modFormControlsToCenter"")"


        'Цикл по обработке всех обьектов формы
        'For Each ctrl In frm.Controls
        For Each ctrl In frm.Section(acDetail).Controls
            With ctrl
                'Расчёт горизонтальной поправки в твипах
                    
                cVal = ctrl.Left + Round(ctrl.Width / 2, 3)    'Отступ слева до середины контрола
                iСorrectionTwips = cVal - iToFormMidHz         'Поправка
                cVal = iСorrectionTwips / cm
                cСorrectionCm = Round(cVal, 3)
                sOne = CStr(Format(cMinFormWidthCm, "0.0"))
                sOne = Replace(sOne, ",", ".")
                sTwo = CStr(cСorrectionCm):   sTwo = Replace(sTwo, ",", ".")
                
                Debug.Print "   '" & ctrl.Name
                Debug.Print "    ControlToCenterHz " & sFormLink & ", " & sFormLink & "!" & ctrl.Name & ", " & sOne & ", " & sTwo
                
                'Расчёт вертикальной поправки в твипах
                cVal = ctrl.Top + Round(ctrl.Height / 2, 0)    'Отступ сверху до середины контрола
                iСorrectionTwips = cVal - iToFormMidVr         'Поправка
                cVal = iСorrectionTwips / cm
                cСorrectionCm = Round(cVal, 3)
                cСorrectionCm = cСorrectionCm + curPlusMinusToTopCm
                sOne = CStr(Format(cMinFormHeightCm, "0.0"))
                sOne = Replace(sOne, ",", ".")
                sTwo = CStr(cСorrectionCm)
                sTwo = Replace(sTwo, ",", ".")
                Debug.Print "    ControlToCenterVr " & sFormLink & ", " & sFormLink & "!" & ctrl.Name & ", " & sOne & ", " & sTwo
                DoEvents
            End With
    Next ctrl
    Debug.Print "'--------------------------------------------------------------------"

'--------------------------------------------------------------------
'Возвращаем свойство формы на место:
    DoCmd.OpenForm sFormName, acDesign, "", "", , acHidden
    Forms(sFormName).PopUp = False
    DoCmd.Close acForm, sFormName, acSaveYes
    
'Если изначально была загружена :
    If bIsLoaded = True Then DoCmd.OpenForm sFormName, acNormal  'Открываем снова

ControlsToCenterAutoCode_Bye:
    Set frm = Nothing
    Exit Sub

ControlsToCenterAutoCode_Err:
    MsgBox "Ошибка " & Err.Number & vbCrLf & Err.Description & vbCrLf & _
    "в процедуре: ControlsToCenterAutoCode", vbCritical, "Error!"
    Resume ControlsToCenterAutoCode_Bye

End Sub

MSA-2007 и выше ( 36 kB) Пример