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