Log in

View Full Version : Loop Through N+ Forms / Subforms / SubsubForms



habennin
08-17-2007, 12:33 AM
Hi,

I think this is a basic task but I can't figure it out. I have a situation where I change a record in a table and I want to reset all of the combo boxes that draw on that table source through absolutely all open forms and subforms. Unfortunately some of my subforms have subforms have subforms. That's ugly but it's the way it is. I have written a code that will go through all open forms and their subforms. How can I take this to the n+ level? Any advice is much appreciated.




Dim frm As Form, intI As Integer
Dim intJ As Integer
Dim intK As Integer
Dim intControls As Integer, intForms As Integer
Dim intsubControls As Integer
Dim subfrm As Form
intForms = Forms.Count ' Number of open forms.
If intForms > 0 Then
For intI = 0 To intForms - 1
Set frm = Forms(intI)
Debug.Print frm.Name
intControls = frm.Count
If intControls > 0 Then
For intJ = 0 To intControls - 1

If (frm(intJ).Name = "region_id") Then

frm(intJ).RowSource = "SELECT region_name, region_id FROM region ORDER BY region_name;"

End If

If (TypeOf frm(intJ) Is SubForm) Then

intsubControls = frm(intJ).Form.Count

Set subfrm = frm(intJ).Form

For intK = 0 To intsubControls - 1

If (subfrm(intK).Name = "region_id") Then

subfrm(intK).RowSource = "SELECT region_name, region_id FROM region ORDER BY region_name;"

End If

Debug.Print subfrm.Controls(intK).Name

Next intK

Debug.Print intsubControls


End If

Debug.Print frm(intJ).Name

Next intJ

End If
Next intI

Else

MsgBox "No open forms.", vbExclamation, "Form Controls"

End If

Oorang
09-05-2007, 06:46 AM
Give this a whack:
Option Compare Database
Option Explicit

Private Sub Detail_Click()
'Do just current form:
ResetAllComboBoxes Me
'Do all open forms:
Dim oFrm As Access.Form
For Each oFrm In Access.Forms
ResetAllComboBoxes oFrm
Next
End Sub

Private Function ResetAllComboBoxes(Form As Access.Form, Optional DoSubForms As Boolean = True) As Boolean
'Purpose: To cause all comboboxes in a form and all subforms to requery.
'Method : Creates a collection of controls from main form. Looping through
' collection of controls if a combobox is encountered it is reset, if
' a subform is encountered it's controls are added to the collection
' of controls to be looped through. Continues until all controls in
' in form and subforms have been examined.
'Input : -Form : The form whose comboboxes you want reset.
' -DoSubForms: Optional, flag as False if you do not want to recurse
' through subforms. If omitted value is True.
'Output : Returns True if succesfully completed routine. Returns false if an
' error was encountered during execution.
On Error GoTo Err_Hnd
Const sErrTitle_c As String = "ResetAllComboBoxes: Error "
Const lIncrement_c As Long = 1
Dim oControls As VBA.Collection 'Contains all Access.Controls objects found.
Dim lIndex As Long 'The index marking which collecion of controls
'is being evaluated.
Dim oCurCntrls As Access.Controls 'The current collection of controls.
Dim oSubFrm As Access.SubForm 'The current found-Subform.
Dim oCbx As Access.ComboBox 'The current found-Combobox.
Dim oCtrl As Access.Control 'The current control being evaluated.
'Set to working status:
Access.Echo False, "Working..."
Access.DoCmd.Hourglass True
'Instantiate Controls collection and add Form's controls:
Set oControls = New Collection
oControls.Add Form.Controls, Form.Name
lIndex = lIncrement_c
'Begin looping through all collections of controls:
Do '(Uses post test)
'Loop through current collection of controls:
Set oCurCntrls = oControls.Item(lIndex)
For Each oCtrl In oCurCntrls
Select Case oCtrl.ControlType 'Evaluate control type
Case AcControlType.acSubform
'Add Subforms controls to collection of Controls to be evaluated:
If DoSubForms Then
Set oSubFrm = oCtrl
oControls.Add oSubFrm.Controls, oCtrl.Name
lIndex = lIndex + lIncrement_c
End If
Case AcControlType.acComboBox
'Reset combobox:
Set oCbx = oCtrl
oCbx.Requery
End Select
Next
Loop Until oControls.Count = lIndex
ResetAllComboBoxes = True 'Mark procedure as having completed correctly.
Exit_Proc:
On Error Resume Next 'Prevents error loop.
'Set back to ready status:
Access.Echo True
Access.DoCmd.Hourglass False
Exit Function
Err_Hnd:
ResetAllComboBoxes = False 'Mark procedure as having failed.
'Display error:
VBA.MsgBox VBA.Err.Description, vbCritical + vbMsgBoxSetForeground + vbMsgBoxHelpButton, sErrTitle_c & CStr(VBA.Err.Number), VBA.Err.HelpFile, VBA.Err.HelpContext
'Resume exit procedure to restore interface to available status:
Resume Exit_Proc
End Function