Option Compare Database
Dim strText As String
Dim intFieldLength As Integer
Dim strFormName As String
Dim Screen_ActiveSubformControl As Control
Private Sub Form_Open(Cancel As Integer)
If Me.OpenArgs = "2Subforms" Then GoTo SkipsCtl
If (Me.OpenArgs & "" = "") Then
Set ctlCurrentControl = Forms(Screen.ActiveForm.Name)(Screen.ActiveControl.Name)
Else
If (Me.OpenArgs = Screen.ActiveForm.Name) Then
Set ctlCurrentControl = Forms(Screen.ActiveForm.Name)(Screen.ActiveControl.Name)
Else
Set ctlCurrentControl = Forms(Screen.ActiveForm.Name)(Me.OpenArgs).Form(Screen.ActiveControl.Name)
End If
End If
SkipsCtl:
Me.txtExpanded = ctlCurrentControl
End Sub
Private Sub btnClose_Click()
On Error GoTo Err_btnClose_Click
If Not IsNull(Me.txtExpanded) Then
strText = Me.txtExpanded
ctlCurrentControl = strText
End If
DoCmd.Close
Exit_btnClose_Click:
Exit Sub
Err_btnClose_Click:
MsgBox Err.Description
Resume Exit_btnClose_Click
End Sub
Private Sub btnCancel_Click()
On Error GoTo Err_btnCancel_Click
DoCmd.Close
Exit_btnCancel_Click:
Exit Sub
Err_btnCancel_Click:
MsgBox Err.Description
Resume Exit_btnCancel_Click
End Sub
Function DisplayActiveSubformName()
Dim Msg As String
Dim CR As String
CR = Chr$(13)
If Set_Screen_ActiveSubformControl() = False Then
Msg = "There is no active subform!"
Else
Msg = "Active Form Name = " & Screen.ActiveForm.Name
Msg = Msg & CR
Msg = Msg & "Active ControlName = " & Screen.ActiveControl.Name
Msg = Msg & CR
Msg = Msg & "Active Subform ControlName = "
Msg = Msg & Screen_ActiveSubformControl.Name
Msg = Msg & CR
Msg = Msg & "Active Subform Form Name = "
Msg = Msg & Screen_ActiveSubformControl.Form.Name
End If
MsgBox Msg
End Function
Function Set_Screen_ActiveSubformControl()
Dim frmActive As Form, ctlActive As Control
Dim hWndParent As Long
Set Screen_ActiveSubformControl = Nothing
Set_Screen_ActiveSubformControl = False
On Error Resume Next
Set frmActive = Screen.ActiveForm
Set ctlActive = Screen.ActiveControl
If Err <> 0 Then Exit Function
hWndParent = ctlActive.Parent.Properties("hWnd")
If hWndParent = frmActive.hWnd Then Exit Function
Set_Screen_ActiveSubformControl = FindSubform(frmActive, _
hWndParent)
End Function
Function FindSubform(frmSearch As Form, hWndFind As Long)
Dim I As Integer
On Error GoTo Err_FindSubForm
FindSubform = True
For I = 0 To frmSearch.Count - 1
If TypeOf frmSearch(I) Is SubForm Then
If frmSearch(I).Form.hWnd = hWndFind Then
Set
Screen_ActiveSubformControl = frmSearch(I)
Exit Function
Else
If
FindSubform(frmSearch(I).Form, hWndFind) Then
Exit
Function
End If
End If
End If
Next I
Bye_FindSubform:
FindSubform = False
Exit Function
Err_FindSubForm:
MsgBox Error$, 16, "FindSubform"
Resume Bye_FindSubform
End Function
|