populating listview with array

R

RB Smissaert

Trying to make a general purpose function to populate a ListView with
a 2-D array.

This is what I have now:

Sub FillListViewWithArray(ByRef arr As Variant, ByRef LV As ListView)

Dim xListItem As listItem
Dim LB1 As Byte
Dim LB2 As Byte
Dim UB1 As Long
Dim UB2 As Long
Dim i As Long
Dim c As Long

LB1 = LBound(arr)
LB2 = LBound(arr, 2)
UB1 = UBound(arr)
UB2 = UBound(arr, 2)

With LV
For i = LB1 To UB1
If Len(arr(i, LB2)) > 0 Then
Set xListItem = .ListItems.Add(, , arr(i, LB2))
For c = LB2 + 1 To UB2
If Len(arr(i, c)) > 0 Then
xListItem.SubItems(c - LB2) = arr(i, c)
Else
'Adding empty values to a listview can cause GPFs
xListItem.SubItems(c - LB2) = " "
End If
Next
End If
Next
End With

End Sub

It fails however with the error Invalid property value on the line:
xListItem.SubItems(c - LB2) = arr(i, c)
So the first column gets fills fine, but the second column (the first
subitem) fails.

I am sure I am overlooking something simple here but can't find out what.
Thanks for any advice.


RBS
 
R

RB Smissaert

Solved this now.
Need to add the column headers first and have to make the view of the type
lvwReport.
This works now:

Sub FillListViewWithArray(ByRef arr As Variant, _
ByRef LV As ListView)

Dim xListItem As listItem
Dim LB1 As Byte
Dim LB2 As Byte
Dim UB1 As Long
Dim UB2 As Long
Dim i As Long
Dim c As Long

LB1 = LBound(arr)
LB2 = LBound(arr, 2)
UB1 = UBound(arr)
UB2 = UBound(arr, 2)

With LV
.View = lvwReport
.ColumnHeaders.Add Text:="main"
.ColumnHeaders.Add Text:="subcol1"
.ColumnHeaders.Add Text:="subcol2"
For i = LB1 To UB1
If Len(arr(i, LB2)) > 0 Then
Set xListItem = .ListItems.Add(, , arr(i, LB2))
For c = LB2 + 1 To UB2
If Len(arr(i, c)) > 0 Then
xListItem.SubItems(c - LB2) = arr(i, c)
Else
'Adding empty values to a listview can cause GPFs
xListItem.SubItems(c - LB2) = " "
End If
Next
End If
Next
End With

End Sub


RBS
 
R

RB Smissaert

Might as well add the column names as an array argument to the Sub:

Sub FillListViewWithArray(ByRef arrData As Variant, _
ByRef arrFields As Variant, _
ByRef LV As ListView)

Dim xListItem As listItem
Dim LB1 As Byte
Dim LB2 As Byte
Dim UB1 As Long
Dim UB2 As Long
Dim LBFields As Byte
Dim UBFields As Long
Dim i As Long
Dim c As Long

LB1 = LBound(arrData)
LB2 = LBound(arrData, 2)
UB1 = UBound(arrData)
UB2 = UBound(arrData, 2)

LBFields = LBound(arrFields)
UBFields = UBound(arrFields)

With LV
.View = lvwReport
For c = LBFields To UBFields
.ColumnHeaders.Add Text:=arrFields(c)
Next
For i = LB1 To UB1
If Len(arrData(i, LB2)) > 0 Then
Set xListItem = .ListItems.Add(, , arrData(i, LB2))
For c = LB2 + 1 To UB2
If Len(arrData(i, c)) > 0 Then
xListItem.SubItems(c - LB2) = arrData(i, c)
Else
'Adding empty values to a listview can cause GPFs
xListItem.SubItems(c - LB2) = " "
End If
Next
End If
Next
End With

End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top