[AccessD] Saving subform format

Bill Benson bensonforums at gmail.com
Thu Jun 12 00:42:46 CDT 2014


Well, I don’t know whether or not to be surprised:  I was able to get this to work… for the most part. I employed it on the change event of a combo that switches between forms for the subform control’s sourceobject (Company and Driver). The only problem I had is that one of the forms wants to show up in Design View even though the default view on both the source objects is datasheet. Oh well, that is hopefully some easily remedied glitch.  The key for me was opening each form in DESIGN VIEW to implant the user’s column changes; In DataSheet view the save did not “stick.” Strange. Hopefully this code is readable; 


‘Combo Change
Private Sub C_Change()
ModifySourceObject
End Sub

Private Sub ModifySourceObject()
Dim V(), Ctrl As Control, F As Form, i As Long, iUB as Long
Dim sFrmName As String
Dim iColumnOrder As Long

On Error Resume Next
‘X is my Subform, C is my Combo
Set F = X.Form
If Err.Number <> 0 Then
    GoTo Exit_Me
End If
On Error GoTo 0
ReDim V(1 To 4, 0 To 0)

For Each Ctrl In X.Form.Controls
    iColumnOrder = 0
    On Error Resume Next  ‘Not all controls have this property
    iColumnOrder = Ctrl.ColumnOrder
    On Error Resume Next
    If iColumnOrder > 0 Then ‘This is my way of expanding the array only as needed
        iUB = UBound(V, 2) + 1
        If iUB = 1 Then
            ReDim V(1 To 4, 1 To iUB)
        Else
            ReDim Preserve V(1 To 4, 1 To iUB)
        End If
‘These are the properties I want to retain and set permanently
        V(1, iUB) = Ctrl.Name
        V(2, iUB) = Format(Ctrl.ColumnOrder, "000")
        V(3, iUB) = Ctrl.ColumnWidth
        V(4, iUB) = Ctrl.ColumnHidden
    End If
Next
If UBound(V, 2) = 0 Then
    MsgBox X.Form.Name & " has no columns or was not in datasheet view… glitch??"
    GoTo Exit_Me
End If
X.SourceObject = ""

MyQuickSort_Single V, 1, iUB, 2, True

sFrmName = "Example" & IIf(C = "Company", "Driver", "Company")

DoCmd.Echo False ‘Better be sure this is set back to true!
DoCmd.OpenForm sFrmName, acDesign ‘In my testing, design view was a must
Set F = Forms(sFrmName)
For i = V(2, UBound(V, 2)) To 1 Step -1   ‘Was going backwards overkill?
    DoCmd.OpenForm sFrmName, acDesign
    Set F = Forms(sFrmName)
    bChangeRequired = False
    For Each Ctrl In F.Controls
        If Ctrl.Name = V(1, i) Then
            Ctrl.ColumnOrder = V(2, i)
            Ctrl.ColumnHidden = V(4, i)
            Ctrl.ColumnWidth = V(3, i)
            Exit For
        End If
    Next
Next
DoCmd.RunCommand acCmdSave ‘This works in design view, useless in datasheet view
DoCmd.Close acForm, F.Name
Set F = Nothing
Exit_Me:
DoCmd.Echo True
X.SourceObject = "Example" & C

‘I was doing this to try to help the swapped to form appear in DS view, did not really help I don’t think

X.SetFocus
DoCmd.RunCommand acCmdSubformDatasheet
End Sub


Sub MyQuickSort_Single(ByRef SortArray As Variant, ByVal First As Long, ByVal Last As Long, _
                                                          ByVal PrimeSort As Integer, ByVal Ascending As Boolean)
Dim Low As Long, High As Long
Dim temp As Variant, List_Separator1 As Variant
Dim TempArray() As Variant
Dim i As Long
ReDim TempArray(UBound(SortArray, 1))
Low = First
High = Last
List_Separator1 = SortArray(PrimeSort, (First + Last) / 2)
Do
    If Ascending = True Then
        Do While (SortArray(PrimeSort, Low) < List_Separator1)
            Low = Low + 1
        Loop
        Do While (SortArray(PrimeSort, High) > List_Separator1)
            High = High - 1
        Loop
    Else
        Do While (SortArray(PrimeSort, Low) > List_Separator1)
            Low = Low + 1
        Loop
        Do While (SortArray(PrimeSort, High) < List_Separator1)
            High = High - 1
        Loop
    End If
    If (Low <= High) Then
        For i = LBound(SortArray, 1) To UBound(SortArray, 1)
            TempArray(i) = SortArray(i, Low)
        Next
        For i = LBound(SortArray, 1) To UBound(SortArray, 1)
            SortArray(i, Low) = SortArray(i, High)
        Next
        For i = LBound(SortArray, 1) To UBound(SortArray, 1)
            SortArray(i, High) = TempArray(i)
        Next
        Low = Low + 1
        High = High - 1
    End If
Loop While (Low <= High)
If (First < High) Then MyQuickSort_Single SortArray, First, High, PrimeSort, Ascending
If (Low < Last) Then MyQuickSort_Single SortArray, Low, Last, PrimeSort, Ascending
End Sub





More information about the AccessD mailing list