AW: ListView FullRowSelect funktioniert nur bedingt
26.05.2008 00:24:01
Herbert
Hi,
Private Sub Tabelle_einlesen()
Dim Dummy
Dim lsvZeile As Integer
Dim Zeile As Integer
Dim Spalte As Integer
Dim Summe As Double
Dim ZeileE As Integer
ZeileE = Cells.Find("*", _
searchdirection:=xlPrevious).Row ' End-Zeile der gesamten Tabelle
Summe = 0
Zeile = DatenZeile1
ListView1.ListItems.Clear
Label1.Caption = "0,00" 'Monatssumme auf 0 setzen
Mo = Format(Cells(10, 3), "00") 'aktuellen Monat als Ziffer
While Mid(Cells(Zeile, 1).Text, 3, 2) Mo 'erste Zeile aktueller Monats suchen
Zeile = Zeile + 1
If Zeile > ZeileE Then 'd.h. noch keine Daten für diesen Monat
Exit Sub
End If
Wend
lsvZeile = 1
With ListView1
While (Mid(Cells(Zeile, 1).Text, 3, 2) = Mo)
Dummy = ""
If Cells(Zeile, 6).Text = "" Then
Dummy = " "
Else
Dummy = Cells(Zeile, 6).Text
End If
.ListItems.Add , , Left(Cells(Zeile, 1).Text, 6) ' _
JaMoNr
.ListItems(lsvZeile).SubItems(1) = Format(Cells(Zeile, 2), "d") ' Tag
.ListItems(lsvZeile).SubItems(2) = Cells(Zeile, 3).Text ' _
KdNr/LiNr
.ListItems(lsvZeile).SubItems(3) = Cells(Zeile, 4).Text ' _
Name
.ListItems(lsvZeile).SubItems(4) = Cells(Zeile, 5).Text
.ListItems(lsvZeile).SubItems(5) = Dummy ' Betrag
.ListItems(lsvZeile).SubItems(6) = Cells(Zeile, 7).Text ' fällig am
.ListItems(lsvZeile).SubItems(7) = Cells(Zeile, 8).Text ' bezahlt am
.ListItems(lsvZeile).SubItems(8) = Cells(Zeile, 9).Text ' Art _
- Bank
Summe = Summe + Cells(Zeile, 6) ' _
Beträge addieren
lsvZeile = lsvZeile + 1
Zeile = Zeile + 1
Wend
End With
Label1 = Format(Summe, "#,##0.00") ' Summe unter ListView eintragen
Call lvw_SetColor(ListView1, &HC0&, 8, 0) ' Spalte "bezahlt am" rot färben
Call lvw_SetColor(ListView1, &HC0&, 9, 0) ' Spalte "Art-Bank" rot färben
ListView1.SetFocus
End Sub
mfg Herbert