View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
RB Smissaert RB Smissaert is offline
external usenet poster
 
Posts: 2,452
Default populating listview with array

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


"RB Smissaert" wrote in message
...
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