Hi,
I am trying to dynamically fill a listview in visual basic 6, and succeded.
There are 3 possible queries at the moment.
The idea is to set the listview column headers with the ado.rs.name then format the data depending on the column name and set the column widths according to datatypes.
So far the column headers and the values are correct, but i keeps formating the last columns incorrectly.
Here's my code. (The code I am having trouble with is marked by *****)
==========================
==========
==========
==========
==========
==========
==========
Private Sub lvwStockTotals_DblClick()
On Error GoTo errorhandler
Dim str As String
With lvwStockTotals
.FullRowSelect = True
str = .SelectedItem
End With
Me.lvwDetails.ListItems.Cl
ear
Me.lvwDetails.ColumnHeader
s.Clear
SQLrsFictStock = ""
'Select the necessary query based on the selection in the first listview.
If str = "In stock" Then
Me.lblType = "In Stock"
SQLrsFictStock = "SELECT C.Name Warehouse, Pcs, Colli, Kgs, Cbm, Plts FROM Stock S, Customers C WHERE S.WareID=C.CustID AND S.ArtID = " & Me.lblArtID
ElseIf str = "Expected in" Then
Me.lblType = "Expected In"
SQLrsFictStock = "SELECT P.Name Pickup, I.PUDate Date, D.Name Delivery, I.DelDate Date, I.InOutID Reference, R.Pcs, R.Colli, R.Kgs, R.Cbm, R.Plts FROM [Rows] R, InOutHeaders I, Customers P, Customers D Where R.HeaderID = i.InOutID AND P.CustID=I.PUID AND D.CustID=I.DelID AND I.DirIN = 1 AND R.Confirmed = 0 AND ArtID = " & Me.lblArtID
ElseIf str = "Reserved out" Then
Me.lblType = "Reserved Out"
SQLrsFictStock = "SELECT P.Name Pickup, I.PUDate Date, D.Name Delivery, I.DelDate Date, I.InOutID Reference, R.Pcs, R.Colli, R.Kgs, R.Cbm, R.Plts FROM [Rows] R, InOutHeaders I, Customers P, Customers D Where R.HeaderID = i.InOutID AND P.CustID=I.PUID AND D.CustID=I.DelID AND I.DirIN = 0 AND R.Confirmed = 0 AND ArtID = " & Me.lblArtID
Else
Exit Sub
End If
If OpenrsFictStock = True Then ' A function to open this specific recordset.
If rsFictStock.BOF = False Then ' check that
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim RSF As Byte
RSF = rsFictStock.Fields.Count - 1
k = 1
rsFictStock.MoveFirst
'Headers & alignment
For i = 0 To RSF
'dynamically add the column headers
Me.lvwDetails.ColumnHeader
s.Add , , rsFictStock.Fields(i).Name
'Align the columns and set the width based on the datatype
If IsNumeric(rsFictStock.Fiel
ds(i).Valu
e) Then
If i = 0 Then 'First column must always be aligned to the left
Me.lvwDetails.ColumnHeader
s(i + 1).Alignment = lvwColumnLeft
Me.lvwDetails.ColumnHeader
s(i + 1).Width = 2000
Else
Me.lvwDetails.ColumnHeader
s(i + 1).Alignment = lvwColumnRight
Me.lvwDetails.ColumnHeader
s(i + 1).Width = 1000
End If
ElseIf IsDate(rsFictStock.Fields(
i).Value) Then
Me.lvwDetails.ColumnHeader
s(i + 1).Alignment = lvwColumnLeft
Me.lvwDetails.ColumnHeader
s(i + 1).Width = 1000
Else
Me.lvwDetails.ColumnHeader
s(i + 1).Alignment = lvwColumnLeft
Me.lvwDetails.ColumnHeader
s(i + 1).Width = 2000
End If
Next i
rsFictStock.MoveFirst
'Fill the rows
Dim l As Integer
l = 1
Do While rsFictStock.EOF = False
'Create the itemlists. Always the first of the rs selection list
Me.lvwDetails.ListItems.Ad
d , , rsFictStock.Fields(0).Valu
e
'Fill the rows of the listview column by column
For j = 0 To RSF
***** This code doesn't format the columns correctly, though all the data is in the correct place.
' If IsDate(rsFictStock.Fields(
j).Value) Then
' Me.lvwDetails.ListItems(k)
.SubItems(
j) = Format(rsFictStock.Fields(
j).Value, "DD-MM-YY")
' ElseIf Me.lvwDetails.ColumnHeader
s(j) = "Cbm" Then
' Me.lvwDetails.ListItems(k)
.SubItems(
j) = Format(rsFictStock.Fields(
j).Value, "#.##0")
' ElseIf Me.lvwDetails.ColumnHeader
s(j) = "Kgs" Then
' Me.lvwDetails.ListItems(k)
.SubItems(
j) = Format(rsFictStock.Fields(
j).Value, "Fixed")
' ElseIf Me.lvwDetails.ColumnHeader
s(j) = "Plts" Then
' Me.lvwDetails.ListItems(k)
.SubItems(
j) = Format(rsFictStock.Fields(
j).Value, "Fixed")
' Else
' Me.lvwDetails.ListItems(k)
.SubItems(
j) = rsFictStock.Fields(j).Valu
e
' End If
****** this code is simimar to the above code except I tried to use another integer variable to do the ******subitems
If Me.lvwDetails.ColumnHeader
s(l) = "Date" Then
Me.lvwDetails.ListItems(k)
.SubItems(
l) = Format(rsFictStock.Fields(
j).Value, "DD-MM-YY")
ElseIf Me.lvwDetails.ColumnHeader
s(l) = "Cbm" Then
Me.lvwDetails.ListItems(k)
.SubItems(
l) = Format(rsFictStock.Fields(
j).Value, "#.##0")
ElseIf Me.lvwDetails.ColumnHeader
s(l) = "Kgs" Then
Me.lvwDetails.ListItems(k)
.SubItems(
l) = Format(rsFictStock.Fields(
j).Value, "Fixed")
ElseIf Me.lvwDetails.ColumnHeader
s(l) = "Plts" Then
Me.lvwDetails.ListItems(k)
.SubItems(
l) = Format(Null2Dbl(rsFictStoc
k.Fields(j
).Value), "Fixed")
Else
Me.lvwDetails.ListItems(k)
.SubItems(
l) = rsFictStock.Fields(j).Valu
e
End If
l = l + 1
Next j
k = k + 1
rsFictStock.MoveNext
Loop
rsFictStock.Close
Set rsFictStock = Nothing
AdoConn.Close 'Opened in the OpenrsFictStock function
Set AdoConn = Nothing
End If
With Me.lvwDetails
.HideColumnHeaders = False
.View = lvwReport
End With
End If
Exit Sub
errorhandler:
errore FrmFictStock, "lvwStockTotals, DblCick"
==========================
==========
==========
==========
==========
==========
==========