On May 27, 1:35 pm, moua...@yahoo.com wrote:

[Ancient Code Alert]

I place some empty hidden text boxes on a report and do something
like:

Private Sub Report_Open(Cancel As Integer)

...

lngWidthVals(1) = CLng(0.4 * 1440) 'Line
lngWidthVals(2) = CLng(0.4 * 1440) 'Quantity

...

lngWidthVal = 0
Set MyRS = MyDB.OpenRecordset("qryShipperColumnOrder", dbOpenDynaset)

If MyRS.RecordCount > 0 Then
 MyRS.MoveLast
 lngCount = MyRS.RecordCount
 MyRS.MoveFirst
 'Set the first value
 lngNewLeft(1) = CLng(0.05 * 1440)
 Me!txtHeading1.Properties("Left") = lngNewLeft(1)
 If lngCount < 11 Then
   'Pad the sizes
   'Add the widths and expand to 7.45 in
   lngSum = 0
   For I = 1 To lngCount
     lngSum = lngSum + lngWidthVals(I)
   Next I
   For I = 1 To lngCount
     lngWidthVals(I) = CLng(lngWidthVals(I) * 7.4 * 1440# /
CDbl(lngSum))
     'MsgBox ("lngWidthVals(" & I & ") = " & lngWidthVals(I))
   Next I
 End If
...

For I = 1 To lngCount
 Select Case I
   Case 1:
   Me!txtHeading1.Caption = MyRS("ReportColumnName")
   txtHeading1.properties("Visible") = True
   'call subroutine to get width and data textbox properties
   GoSub WVal
   lngNewLeft(2) = lngNewLeft(1) + lngWidthVal
   Case 2:
   Me!txtHeading2.Properties("Left") = lngNewLeft(2)
   Me!txtHeading2.Caption = MyRS("ReportColumnName")
   txtHeading2.Properties("Visible") = True
   GoSub WVal
   lngNewLeft(3) = lngNewLeft(2) + lngWidthVal
   Case 3:
   ...
Exit Sub

WVal:

Select Case strColumnName
 Case "Line": lngWidthVal = lngWidthVals(1)
   theLine.Properties("Width") = lngWidthVal
   theLine.Properties("Left") = lngNewLeft(I)
   theLine.Properties("Visible") = True
 Case "Quantity": lngWidthVal = lngWidthVals(2)
   theQuantity.Properties("Width") = lngWidthVal
   theQuantity.Properties("Left") = lngNewLeft(I)
   theQuantity.Properties("Visible") = True
 ...

Return
End Sub

qryShipperColumnOrder:
SELECT ColumnName, ReportColumnName, ListOrderNumber, ValsIndex
FROM tblShipperColumnOrder
WHERE (ListOrderNumber <> 0)
ORDER BY ListOrderNumber DESC;

Note: The empty heading boxes are on the same line in the Page Header
and the textboxes named theLine, theQuantity, etc. are in the same
line in the Detail section.  On the main form I have:

  Report Column Title  Columns picked
chkLine txtLineAlias    lbColumnOrder
chkQuantity txtQuantityAlias
...

lbColumnOrder.RowSource = "SELECT ReportColumnName FROM
tblShipperColumnOrder WHERE (ListOrderNumber <> 0) ORDER BY
ListOrderNumber DESC;"

tblShipperColumnOrder
ColumnName Text
ListOrderNumber Integer
ReportColumnName Text
ValsIndex Integer

ColumnName ListOrderNumber ReportColumnName ValsIndex
Line 9 'PO Line #' 1
Quantity 8 'Qty' 2
...

Private Sub chkLINE_Click()
Dim MyDB As Database
Dim MyRS As Recordset
Dim strCrit As String

Set MyDB = DBEngine.Workspaces(0).Databases(0)
Set MyRS = MyDB.OpenRecordset("tblShipperColumnOrder", dbOpenDynaset)

'-1 on checking, 0 on unchecking
'MsgBox (chkLine.Value)

If chkLine.Value = 0 Then
 'Set ListOrderNumber to 0
 strCrit = "[ColumnName] = " & Chr(34) & "LINE" & Chr(34)
 MyRS.FindFirst strCrit
 MyRS.Edit
 MyRS("ListOrderNumber") = 0
 MyRS.Update
Else
 'Add one to non-zero ListOrderNumbers then set OurQuote to 1
 strCrit = "[ListOrderNumber] <> 0"
 MyRS.FindFirst strCrit
 Do While Not MyRS.NoMatch
   MyRS.Edit
   MyRS("ListOrderNumber") = MyRS("ListOrderNumber") + 1
   MyRS.Update
   MyRS.FindNext strCrit
 Loop
 strCrit = "[ColumnName] = " & Chr(34) & "LINE" & Chr(34)
 MyRS.FindFirst strCrit
 MyRS.Edit
 MyRS("ListOrderNumber") = 1
 MyRS.Update
End If
MyRS.Close
MyDB.Close
lbColumnOrder.Requery
Me.Refresh
Me.Repaint
End Sub

Private Sub txtLineAlias_AfterUpdate()
Dim MyDB As Database
Dim MyRS As Recordset
Dim strCrit As String

Set MyDB = DBEngine.Workspaces(0).Databases(0)
Set MyRS = MyDB.OpenRecordset("tblShipperColumnOrder", dbOpenDynaset)

 'Set ReportColumnname to txtLineAlias
 strCrit = "[ColumnName] = " & Chr(34) & "LINE" & Chr(34)
 MyRS.FindFirst strCrit
 MyRS.Edit
 MyRS("ReportColumnName") = CStr(Nz(txtLineAlias, ""))
 MyRS.Update
MyRS.Close
MyDB.Close
Me.Refresh
Me.Repaint
End Sub

rptShipper.RecordSource = "SELECT Line, Quantity, ... FROM
tblLineItemFields"

tblLineItemFields:
Line Text
Quantity Text
...

cmdFillLineitems_Click()
...
Set MyRS = MyDB.OpenRecordset("qryShipperColumnOrder", dbOpenSnapshot)
strSubformSQL = ""
If MyRS.RecordCount > 0 Then
 strSubformSQL = "SELECT "
 MyRS.MoveLast
 lngCount = MyRS.RecordCount
 MyRS.MoveFirst
 For lngI = 1 To lngCount
   strSubformSQL = strSubformSQL & CStr(MyRS("ColumnName"))

SubFormShipperOrder.Form.Controls.Item(CStr(MyRS("ColumnName"))).ColumnOrder
= lngI
   If lngI <> lngCount Then
     strSubformSQL = strSubformSQL & ", "
     MyRS.MoveNext
   End If
 Next lngI
 strSubformSQL = strSubformSQL & " FROM tblLineItemFields;"
 ...

frmSubShipperOrder.Recordset = "SELECT Line, Quantity, ... FROM
tblLineItemFields ORDER BY Line;"

That code is very old.  I think today I would use Update Queries to
change the table instead using recordsets, but the recordsets worked
so well that I never bothered to change the code.  I think I would
also use a complete subroutine rather than use GoSub since not much
needs to be passed to the subroutine.  The user can select any fields
in any order to show up on the report.  Maybe the code I posted will
give you an idea about how to accomplish your goal more simply.  For
example, constructing the SQL in code for just a query would allow you
to change the order of fields and give them aliases (use square
brackets around the alias if spaces are possible).  I don't see an
easy way to do what you want.  Perhaps ADO offers an elegant means for
the substitution of field names in tandem with the DLookup function.
SQL seems to want a fixed string for an alias.

James A. Fortune
CDMAPoster@FortuneJames.com