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

Выравнивание всплывающей формы по нижнему левому краю поля

Private Sub TestTextPole01_Click()
'Выравнивание всплывающей формы по нижнему левому краю поля "TestTextPole01"
'----------------------------------------------------------------
Dim lNew&, tNew&, lNewPlus&

    DoCmd.OpenForm "ВсплывающаяФорма"
 
'Выравнивание по нижнему левому краю поля "TestTextPole01" :
    With Forms("ВсплывающаяФорма") 'Расчёт смещения
        If Me.RecordSelectors = True Then
            lNewPlus = 180 'поправка на ширину селектора записи + на ширину границы формы
        Else
            lNewPlus = -80 'поправка на ширину границы формы
        End If
        lNew = Me.TestTextPole01.Left + lNewPlus
        tNew = Me.Section(acHeader).Height + Me.TestTextPole01.Top + Me.TestTextPole01.Height
        .Move lNew, tNew 'Порядок : Left, Top, Width, Height
    End With
End Sub




Если Текущая форма тоже всплывающая ...

Private Sub Поле0_DblClick(Cancel As Integer)
' Выравнивание всплывающей формы по нижнему левому краю поля "Поле0"
' Текущая форма тоже всплывающая !!!
'----------------------------------------------------------------
Dim lNew&, tNew&, lNewPlus&, tNewPlus&
 
    DoCmd.OpenForm "Form2"
'Выравнивание по нижнему левому краю поля "Поле0" :
    With Forms("Form2") 'Расчёт смещения
        If Me.RecordSelectors = True Then
            lNewPlus = 200 'поправка на ширину селектора записи + на ширину границы формы
        Else
            lNewPlus = -80 'поправка на ширину границы формы- можно вычислить, но пока не будем
        End If
 
        If Me.ControlBox = True Then
            'поправка на высоту верхней панели формы - можно вычислить, но пока не будем
            tNewPlus = 500
        End If
 
        lNew = Me.WindowLeft + Me.Поле0.Left + lNewPlus
 
        If FormHasHeader = True Then 'Заголовок есть
            tNew = Me.WindowTop + Me.Section(acHeader).Height + Me.Поле0.Top + Me.Поле0.Height + tNewPlus
        Else
            tNew = Me.WindowTop + Me.Поле0.Top + Me.Поле0.Height + tNewPlus
        End If
        .Move lNew, tNew 'Порядок : Left, Top, Width, Height
    End With
End Sub
 
Private Function FormHasHeader() As Boolean
'Возвращает True если указанная в аргументе форма имеет Секции (Заголовок)
'----------------------------------------------------------------------------------------
Dim bVal As Boolean
'----------------------------------------------------------------------------------------
On Error GoTo FormHasSections_Err
    bVal = Me.Section(acHeader).Visible
    FormHasHeader = True
    Exit Function
 
FormHasSections_Err:
    FormHasHeader = False 'Error 2462
    Err.Clear
End Function
Назад ToTop
L.E. 04.04.2024
Рейтинг@Mail.ru