AW: Alternative
10.11.2007 10:18:32
dysti
Hallo Rainer,
habe sowas ähnliches auch gefunden, aber ich bekomme es nicht hin, ein Item in der Spalte 1 oder 2 zu marlieren.
Auf der Form ist nur Listview und ein Button.
Vieleicht weiß einer die Lösung?
Hier der Code:
Public Index As Long
Private Sub UserForm_Initialize()
Dim x As Long
Dim ix As ListItem
With ListView1
.ColumnHeaders.Add , , "Spalte1", 80
.ColumnHeaders.Add , , "Spalte2", 80
.ColumnHeaders.Add , , "Spalte3", 80
.View = 3
For x = 1 To 10
.ListItems.Add , , "Spalte A" + Str(x)
.ListItems(x).SubItems(1) = "Spalte B" + Str(x)
.ListItems(x).SubItems(2) = "Spalte C" + Str(x)
Next
End With
End Sub
Private Sub CommandButton1_Click()
ListView1.ListItems(5).ListSubItems(1).ForeColor = vbBlue
ListView1.ListItems(6).ListSubItems(2).ForeColor = vbBlue
Call ListView_SetRowColor(9, vbBlue, ListView1)
End Sub
Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
Index = Item.Index
Call ListView_SetRowColor(Index, vbRed, ListView1)
End Sub
Private Sub ListView_SetRowColor(ByVal Row As Long, ByVal Color As Long, ByRef lv As _
MSComctlLib.ListView)
Dim n As Long
Dim li As ListItem
Dim lsi As ListSubItem
On Error GoTo procErr
With lv
Set li = .ListItems(Row)
li.ForeColor = Color
For n = 1 To .ColumnHeaders.Count - 1
Set lsi = li.ListSubItems(n)
lsi.ForeColor = Color
Next
Set li = Nothing
Set lsi = Nothing
End With
ExitSub:
On Error GoTo 0
Exit Sub
procErr:
If Err Then
Call MsgBox(CStr(Err.Number) & vbCrLf & _
Err.Description & vbCrLf & _
Err.Source)
Resume ExitSub
End If
End Sub