Public Function IsForm(FormName As String) As Boolean
    Dim frm As Access.AccessObject
    
    For Each frm In CurrentProject.AllForms
        If frm.Name = FormName Then
            IsForm = True
            Exit For
        End If
    Next
End Function

Public Function IsFormOpen(FormName As String) As Boolean
'Returns True if form FormName is open in form view
    With CurrentProject.AllForms(FormName)
        If .IsLoaded Then
            IsFormOpen = (.CurrentView > 0)
        End If
    End With
End Function

Public Function CtrlDataType(frm As Form, ctl As String) As Integer
'Returns the data type of the Control ctl on Form frm

    Dim strRsource As String
    Dim strCsource As String
    '
    With frm
        strRsource = .RecordSource & ""
        strCsource = .Controls(ctl).ControlSource & ""
    End With
    'If form or control is unbound, bail out now
    If Len(strRsource) = 0 Or Len(strCsource) = 0 Then
        Exit Function
    End If
    
    'If recordsource is a table or query name
    If Left$(strRsource, 6) <> "Select" Then
        strRsource = "Select * From " & strRsource
    End If
    'Create temp query to obtain data type from
    'the Fields collection
    CtrlDataType = CurrentDb.CreateQueryDef _
        ("", strRsource).Fields(strCsource).Type
    
End Function

Private Type RECT
    X1 As Long 'Left
    Y1 As Long 'Top
    X2 As Long 'Right
    Y2 As Long 'Bottom
End Type
'
Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal x As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long

Sub RestoreCoords(strAppName As String, frm As Form)
' Restores form frm to the coordinates previously
' saved using SaveCoords (below). Supply the
' title of the application in strAppName
    Dim rct As RECT
    
    With rct
        .X1 = GetSetting(strAppName, frm.Name, "X1", 0)
        .Y1 = GetSetting(strAppName, frm.Name, "Y1", 0)
        .X2 = GetSetting(strAppName, frm.Name, "X2", 0)
        .Y2 = GetSetting(strAppName, frm.Name, "Y2", 0)
        If .X2 > 0 And .Y2 > 0 Then
            SetFormSize frm, rct
        End If
    End With
End Sub

Sub SaveCoords(strAppName As String, frm As Form)
' Saves the coordinates of form frm to the
' Windows Registry. strAppName should contain
' the application's title
    Dim rct As RECT
    
    GetFormSize frm, rct
    With rct
        SaveSetting strAppName, frm.Name, "X1", .X1
        SaveSetting strAppName, frm.Name, "Y1", .Y1
        SaveSetting strAppName, frm.Name, "X2", .X2
        SaveSetting strAppName, frm.Name, "Y2", .Y2
    End With
End Sub

Private Sub GetFormSize(frm As Form, rct As RECT)
' Fills the rectangle rct with the coordinates of form frm
    Dim rctParent As RECT
    Dim hParent As Long
    
    GetWindowRect frm.hwnd, rct
    hParent = GetParent(frm.hwnd)
    If hParent <> Application.hWndAccessApp Then
        GetWindowRect hParent, rctParent
        With rct
            .X1 = .X1 - rctParent.X1
            .Y1 = .Y1 - rctParent.Y1
            .X2 = .X2 - rctParent.X1
            .Y2 = .Y2 - rctParent.Y1
        End With
    End If
End Sub

Private Sub SetFormSize(frm As Form, rct As RECT)
' Sets the coordinates of form frm to those supplied
' in the rectangle rct
    With rct
        MoveWindow frm.hwnd, .X1, .Y1, (.X2 - .X1), (.Y2 - .Y1), True
    End With
End Sub

Public Function FindText(ByVal strFieldName As String)
' Called from the AfterUpdate property of an unbound textbox on
' a bound form. Pass the name of the field to search
' in strFieldName.
' eg: =FindText([CustomerName])
    Dim f As Form, c As Control
    
    Set f = Screen.ActiveForm
    Set c = Screen.ActiveControl
    With f.RecordsetClone
        .FindFirst strFieldName & " Like '" & c & "*'"
        If Not .NoMatch Then
            f.Bookmark = .Bookmark
            c = Null
        Else
            MsgBox "The text '" & c & "' was not found.", vbInformation, "Find Text"
        End If
    End With
End Function

Public Function AutoAdd(ByVal NewData As String, ByVal add2table As String, ByVal fieldName As String, Optional ByVal popForm As Variant) As Integer
'Call from the OnNotInList event of a combo:
' Response = AutoAdd(NewData, "TableToUpdate", "FieldToUpdate", ["FormToPop"])
    Dim strTemp As String
    '
    On Error GoTo Handler
    '
    strTemp = "'" & NewData & "' is not listed." & vbcrlf &
    strTemp = strTemp & "Do you wish to add this as a new entry?" & vbcrlf & vbcrlf & "Choosing 'Yes' will "
    If Not IsMissing(popForm) Then
        strTemp = strTemp & "show a form for you to fill in the details." & vbcrlf
    Else
        strTemp = strTemp & "add this entry for future use." & vbcrlf
    End If
    strTemp = strTemp & "Choosing 'No' will let you re-type the entry or pick one from the list."
    If MsgBox(strTemp, vbYesNo Or vbQuestion, "AutoAdd") = vbYes Then
        With CurrentDb().OpenRecordset(add2table, dbOpenDynaset)
            .AddNew
            .Fields(fieldName) = NewData
            .Update
            .Close
        End With
        If Not IsMissing(popForm) Then
            DoCmd.OpenForm popForm, , , "[" & fieldName & "]='" & NewData & "'", acFormEdit, acDialog, "AutoAdd"
        End If
        AutoAdd = acDataErrAdded
    Else
        AutoAdd = acDataErrContinue
    End If

ExitPoint:
    Exit Function

Handler:
    MsgBox Err.Description & " (" & Err.Number & ")"
    Resume ExitPoint
End Function

Private Type Rect
    Left   As Long
    Top    As Long
    Right  As Long
    Bottom As Long
End Type

Private Const SM_CXVSCROLL As Long = 2
Private Const SM_CYCAPTION As Long = 4
Private Const SM_CXBORDER As Long = 5
Private Const SM_CYBORDER As Long = 6

Private Const VK_ESCAPE = &H1B
Private Const VK_TAB = &H9
Private Const VK_SHIFT = &H10

Private Declare Function GetAsyncKeyState Lib "user32" (ByVal lngKey As Long) As Integer
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As Rect) As Long
Private Declare Function MoveWindow Lib "user32" (ByVal hWnd As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long

Public Function DropDownForm(PopForm$, ctl As Control, Optional AutoClose as Boolean, Optional WhereCondition$, Optional OpenArgs$)
'PopForm is the name of the form to pop-up
'ctl is the Control under which PopForm is to open
'AutoClose means when True, Close PopForm when the user:
'   Clicks outside PopForm's boundaries
'   Presses "Esc", "Tab" or "Shift-Tab"
'WhereCondition is passed to PopForm as it's WhereCondition argument
'OpenArgs is passed to PopForm as it's OpenArgs argument
    Dim CtlRect     As Rect
    Dim popRect     As Rect
    Dim ScreenRect  As Rect
    Dim popFrm      As Form
    Dim NewLeft&, NewTop&, PopWidth&, PopHeight&
    
    DoCmd.OpenForm PopForm, acNormal, , WhereCondition, , acHidden, OpenArgs
    If Forms(PopForm).PopUp = False Then
        DoCmd.Close acForm, PopForm
        MsgBox "The dropdown form's property 'PopUp' must be set to 'Yes'", , "DropDownForm"
        Exit Function
    End If
    Set popFrm = Forms(PopForm)
    
    CtlRect = ControlRect(ctl)
    NewLeft = CtlRect.Left
    NewTop = CtlRect.Bottom
    
    GetWindowRect popFrm.hWnd, popRect
    GetWindowRect Application.hWndAccessApp, ScreenRect
    PopWidth = WinWidth(popRect)
    PopHeight = WinHeight(popRect)
    If ScreenRect.Bottom - NewTop - PopHeight < 0 Then
        NewTop = NewTop - PopHeight - WinHeight(CtlRect)
    End If
    If ScreenRect.Right - NewLeft& - PopWidth& < 0 Then
        NewLeft = ScreenRect.Right - PopWidth
    End If
    
    MoveWindow popFrm.hWnd, NewLeft, NewTop, PopWidth, PopHeight, True
    popFrm.Visible = True
    Set popFrm = Nothing
    
    If AutoClose Then
        On Error Resume Next
        Do
            DoEvents
            If KeyPressed(VK_ESCAPE) Then Exit Do
            If KeyPressed(VK_TAB) Then
                SendKeys "{TAB}"
                Exit Do
            End If
            If KeyPressed(VK_SHIFT) Then
                If KeyPressed(VK_TAB) Then
                    SendKeys "+{TAB}"
                End If
            End If
        Loop While Screen.ActiveForm.Name = PopForm
        DoCmd.Close acForm, PopForm
    End If
End Function

Private Function WinHeight(r As Rect) As Long
    WinHeight = r.Bottom - r.Top + 1
End Function

Private Function WinWidth(r As Rect) As Long
    WinWidth = r.Right - r.Left + 1
End Function

Private Function FormSectionHeight(frm As Form, Sect As Long) As Long
    On Error Resume Next  'In case section not defined
    FormSectionHeight = frm.Section(Sect).Height
End Function

Private Function KeyPressed(plngKey As Long) As Boolean
    KeyPressed = (GetAsyncKeyState(plngKey) < 0)
End Function

Private Function ControlRect(ctl As Control) As Rect
    Dim destRect As Rect
    Dim CtlRect  As Rect
    Dim destFrm  As Form
    Dim vAdj&, hAdj&, rows&
    
    If TypeOf ctl.Parent Is Page Then
        Set destFrm = ctl.Parent.Parent.Parent
        vAdj = -GetSystemMetrics(SM_CYCAPTION)
    Else
        Set destFrm = ctl.Parent
    End If
    With ctl
        Select Case .Section
            Case acHeader
            Case acDetail
                vAdj = vAdj + TwipsToPixels(FormSectionHeight(destFrm, acHeader), "V")
            Case acFooter
                vAdj = vAdj + TwipsToPixels(FormSectionHeight(destFrm, acHeader), "V")
                vAdj = vAdj + TwipsToPixels(FormSectionHeight(destFrm, acDetail) * rows, "V")
            Case Else
        End Select
        vAdj = vAdj + GetSystemMetrics(SM_CYBORDER) + GetSystemMetrics(SM_CYCAPTION) + 2
        hAdj = GetSystemMetrics(SM_CXBORDER)
        If destFrm.RecordSelectors = True Then
            hAdj = hAdj + GetSystemMetrics(SM_CXVSCROLL) + 3
        End If
        GetWindowRect destFrm.hWnd, destRect
        
        CtlRect.Top = vAdj + destRect.Top + TwipsToPixels(.Top, "V")
        CtlRect.Bottom = vAdj + destRect.Top + TwipsToPixels(.Top + .Height, "V")
        CtlRect.Left = hAdj + destRect.Left + TwipsToPixels(.Left, "H")
        CtlRect.Right = hAdj + destRect.Left + TwipsToPixels(.Left + .Width, "V")
    End With
    ControlRect = CtlRect
End Function

Public Sub SelectAll(lst As ListBox)
'Select all items in multi-select listbox lst
    ListSelect lst, True
End Sub

Public Sub UnSelectAll(lst As ListBox)
'De-select all items in multi-select listbox lst
    ListSelect lst, False
End Sub

Private Sub ListSelect(lst As ListBox, state As Boolean)
    Dim i As Long
    With lst
        For i = 0 To .ListCount - 1
            .Selected(i) = state
        Next
    End With
End Sub

Public Function IsSubform(frm As Form) As Boolean
'Returns True if frm has a parent form
    Dim s As String
    On Error Resume Next
    s = frm.Parent.Form.NAME
    IsSubform = (Err.Number = 0)
End Function