Question : Access subform - grow as nececssary to show all rows

Hello all;

I have a form with several subforms.  Each subform is a grid style subform (that is, a header with column headings, and rows for each record.)  What I want to do but cannot figure out how is make each subform grow as necessary to display all records for that subform.

Each subform may have only a single record, up to 10+ (maybe more in some cases.)  I want the parent form then to grow as necessary also to display all subforms, and each of their rows.  In some cases the parent form may be small enough to fit on a single screen, in other cases (cases with subforms that have 10+ records each), the parent form would be very long and would have a scroll bar.

The problem is that the 'Can Grow' and 'Can Shrink' properties only apply to reports/printing, not the actual subform when in edit mode.

Obviously, I could just put scroll bars on each subform, but that would be ugly and clunky.  

Can anyone help?  Thanks!

Answer : Access subform - grow as nececssary to show all rows

Hi UptimeSystems

Try the attached code in your Form_Current procedure.  You might have to tweak it slightly, but it should give you the general idea.

You'll probably want to add some error handling too :-)

--
Graham

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
Private Sub Form_Current()
Dim aSubforms As Variant
Dim aLabels As Variant
Dim aMaxRows As Variant
Dim lTop As Long
Dim lHeight As Long
Dim lNextTop As Long
Dim lRows As Long
Dim sbf As SubForm
Dim i As Integer
Const cGap = 20
aSubforms = Array("sbf1", "sbf2") ' names of subform controls
aLabels = Array("lblsbf1", "lblsbf2") ' names of attached labels
aMaxRows = Array(15, 0) ' maximum rows for each subform (0 for no limit)
Me.Painting = False
lNextTop = 10 ' top of first subform or associated label
For i = 0 To UBound(aSubforms)
  Set sbf = Me(aSubforms(i))
  If sbf.Controls.Count = 0 Then
    lTop = lNextTop
  Else
    lTop = lNextTop + sbf.Controls(0).Height
  End If
  With sbf.Form
    If .RecordsetClone.RecordCount > 0 Then
      .RecordsetClone.MoveLast ' ensure all rows are loaded
    End If
    lRows = .RecordsetClone.RecordCount + Abs(.AllowAdditions)
    If lRows > aMaxRows(i) And aMaxRows(i) <> 0 Then lRows = aMaxRows(i)
    lHeight = lRows * (.Section(acDetail).Height + 10) _
      + .Section(acHeader).Height + .Section(acFooter).Height
  End With
  lNextTop = lTop + lHeight + cGap
  ' expand section if necessary
  If Me.Section(acDetail).Height < lNextTop Then
    Me.Section(acDetail).Height = lNextTop
  End If
  sbf.Height = 0
  sbf.Top = lTop
  sbf.Height = lHeight
  If Len(aLabels(i)) <> 0 Then
    With Me(aLabels(i))
      .Top = lTop - .Height
    End With
  End If
Next
Me.Section(acDetail).Height = lNextTop
Me.Painting = True
End Sub
Random Solutions  
 
programming4us programming4us