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