On Sat, 19 Aug 2006 20:40:10 -0400, "(PeteCresswell)" <x@y.Invalidwrote:
>Per polite person:
>>To make these things editable you need to use a temporary table.
I have posted an small example in A97 to
http://rapidshare.de/files/30030032/...ample.zip.html
This was created by a sort of wizard I wrote a long time ago!
Can the work table be flipped back to the storage format in a way that does not
require hard-coding for different values?
Yes, there is no no coding which depends on the actual values in the table.
A standalone example of code:
Function CrossToLinear(CrossTableName, NumRowFields, ColumnFieldName, _
ValueFieldName) As Boolean ' result is success/failure indicator
' Use this for reconverting from crosstab format table.
' Assumes that (row fields + column field) are unique in the output
table, ie
' the original crosstab had only one record contributing to each
value.
' Assumes that the input table (crosstab table) is in the form:
' all the row heading fields first (NumRowfields of them)
' then the columns.
' Creates an output table in the format:
' all the row heading fields
' then the column heading field
' then the value field
' Example
'CrossTable has fields and values
'Person, Project, Jan, Feb, Mar, Apr ...
'Fred, Holidays, 3,0,0,5, ...
'result = CrossToLinear("CrossTable",2,"Month","Days")
'Output table has fields and values
'Person, Project, Month, Days
'Fred, Holidays, Jan, 3
'Fred, Holidays, Apr, 5
' ...
Dim CurrentDatabase As DATABASE
Dim LinearTableName$
Dim LinearTableDef As TableDef ' for output table
Dim LinearTableSet As Recordset
Dim CrossTableDef As TableDef ' for input table
Dim CrossTableSet As Recordset
Dim myfield As Field, myfield2 As Field
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim record_started As Boolean
On Error GoTo myerror
Set CurrentDatabase = DBEngine(0)(0)
LinearTableName$ = CrossTableName & "_Lin"
'Create new TableDef object. Delete first if already there
On Error Resume Next
CurrentDatabase.TableDefs.Delete LinearTableName
On Error GoTo myerror
Set LinearTableDef = CurrentDatabase.CreateTableDef(LinearTableName)
'Open input table def to get details of row and value field details:
Set CrossTableDef = CurrentDatabase.TableDefs(CrossTableName)
For i = 0 To NumRowFields - 1
' Create output Field object:
Set myfield2 = CrossTableDef.Fields(i) 'temp
Set myfield = LinearTableDef.CreateField(myfield2.Name, _
myfield2.Type, myfield2.Size)
LinearTableDef.Fields.Append myfield
Next i
'now add column heads field
Set myfield = LinearTableDef.CreateField(ColumnFieldName, dbText, 50)
' 50 for example
LinearTableDef.Fields.Append myfield
'now add value field
Set myfield2 = CrossTableDef.Fields(NumRowFields) 'temp
Set myfield = LinearTableDef.CreateField(ValueFieldName,
myfield2.Type, myfield2.Size)
LinearTableDef.Fields.Append myfield
CurrentDatabase.TableDefs.Append LinearTableDef
' Open output table
Set LinearTableSet = CurrentDatabase.OpenRecordset(LinearTableName, _
DB_OPEN_DYNASET)
' Open input table
Set CrossTableSet = CurrentDatabase.OpenRecordset(CrossTableName, _
DB_OPEN_DYNASET, DB_FORWARDONLY)
'if there are any records
If Not (CrossTableSet.BOF And CrossTableSet.EOF) Then
record_started = False
Do Until CrossTableSet.EOF 'for each record in crosstableset
For j = NumRowFields To CrossTableSet.Fields.Count - 1
'(for each crosstab column field)
Set myfield = CrossTableSet.Fields(j)
If IsNull(myfield.Value) Then
'ignore null entries
Else
'Add data to linear table
If Not record_started Then
' Prepare new record.
LinearTableSet.AddNew
record_started = True
For k = 0 To NumRowFields - 1
'copy all the row fields
LinearTableSet.Fields(k) = _
CrossTableSet.Fields(k)
Next k
End If
'now set the column field value
LinearTableSet.Fields(NumRowFields) = myfield.Name
'now set the value field value
LinearTableSet.Fields(ValueFieldName) = myfield.Value
End If
' Save record.
If record_started Then
LinearTableSet.UPDATE
record_started = False
End If
Next j
CrossTableSet.MoveNext
Loop
End If
LinearTableSet.Close
CrossTableSet.Close
CrossToLinear = True
Exit Function
myerror:
MsgBox "Error in CrossToLinear, number " & Err.Number & ": " &
Err.Description
CrossToLinear = False
'may leave things open!
Exit Function
End Function
---
The example on Rapidshare includes use of a form with dynamic headings, which can be used
with different tables. It can also deal with crosstabs with more than one value field. The only
dependence on the table is through the calling sequence on the menu form.