VBA-Beispiel 141
mail schreiben
mail schreiben

Demo ListView-Control in UserForm

Die Datei enthält zwei UserFormen mit je einem ListView-Control.

Datenquelle des zweiten ListViews ist der dynamische Bereichsname "rngDaten".
'Verweis für ListView-Steuerelement unter Extras/Verweise:
'   Microsoft Windows Common Controls 6.0(SP6)

Private Sub UserForm_Initialize()
Dim lngZe As Long, lngSp As Long
Dim rng As Range
Dim intBreite As Integer

  Set rng = Range("rngDaten")

  With Me.ListView1
    .FullRowSelect = True
    .View = 3              'Listenansicht
    .Gridlines = True
    '.HotTracking = True   'Mauszeiger wird zur Hand
    .HideSelection = False  'aktive Item bleibt grau
                           'wenn ListView ohne Focus
    .AllowColumnReorder = True  'Spalten verschieben
    '.CheckBoxes = True
    '.BackColor = RGB(75, 139, 103)
    '.MultiSelect = True

    'Spalten einfügen
    'Beschriftung:  wie erste Zeile "rngDaten"
    'Spaltenbreite: steht im Zellkommentar und
    '               wurde/wird durch QueryClose geschrieben
    For lngSp = 1 To rng.Columns.Count
      On Error Resume Next
        intBreite = rng.Cells(1, lngSp).Comment.Text
        If intBreite = 0 Then intBreite = 10
      On Error GoTo 0

      .ColumnHeaders.Add , , rng.Cells(1, lngSp), intBreite
    Next lngSp

    Call DatenLesen(rng)
  End With

  Set rng = Nothing
End Sub

Private Sub DatenLesen(ByVal rng As Range) Dim lngZe As Long, lngSp As Long '--------------------------------------------------------------- 'ListView mit Datenzeilen füllen. 'Datenquelle ist der Zellbereich "rngDaten" in Tabelle1. 'Mehr zum Bereichsnamen "rngDaten" siehe Infokasten in Tabelle1. '--------------------------------------------------------------- With Me.ListView1 .ListItems.Clear 'Alle Zeilen durchgehen (incl. Überschrift) For lngZe = 1 To rng.Rows.Count 'Haupteintrag (erste Spalte) ' In diesem Beispiel werden nur Key und Text eingetragen. ' Als Key wird die Zeile mit einem vorangestelltem x verwendet. ' Damit kann später (löschen) die korrekte Zeile ermittelt werden. ' Key darf aber nicht mit einer Zahl beginnen. ' Index, Key, Text, Icon, SmallIcon .ListItems.Add , "x" & lngZe, rng.Cells(lngZe, 1) 'zweite Spalte bis letzte Spalte For lngSp = 2 To rng.Columns.Count .ListItems(lngZe).SubItems(lngSp - 1) = rng.Cells(lngZe, lngSp) Next lngSp Next lngZe .ListItems.Remove (1) 'Überschriften (als Item) wieder entfernen. 'ein Item auswählen 'If .ListItems.Count > 50 Then .ListItems(51).Selected = True '.ListItems(51).EnsureVisible 'und Item ins Bild rücken End With Me.Caption = Space(10) & Me.ListView1.ListItems.Count & " Zeilen" End Sub
Private Sub ListView1_ColumnClick( _ ByVal ColumnHeader As MSComctlLib.ColumnHeader) '-------------------------------------------- 'Nach Klick auf Spaltenkopf des ListViews 'ausgewählte Spalte auf- absteigend sortieren '-------------------------------------------- With Me.ListView1 .SortOrder = IIf(.SortOrder, 0, 1) 'wechseln .SortKey = ColumnHeader.SubItemIndex 'Spalte .Sorted = True 'sortieren End With End Sub
Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem) Dim lngZe As Long, lngSp As Long, lngDS As Long '--------------------------------------- 'Ausgewähltes Item in Tabelle2 eintragen '--------------------------------------- lngZe = 3 lngDS = Mid(Item.Key, 2) 'Datensatz 'MsgBox Item.Key & " > " & lngDS For lngSp = 1 To Me.ListView1.ColumnHeaders.Count Tabelle2.Cells(lngZe, 2) = Range("rngDaten").Cells(1, lngSp) Tabelle2.Cells(lngZe, 3) = Range("rngDaten").Cells(lngDS, lngSp) lngZe = lngZe + 1 Next lngSp End Sub
Private Sub cmbLoeschen_Click() Dim lngZe As Long Dim intAnt As Integer 'Me.Hide If Me.ListView1.SelectedItem Is Nothing Then Exit Sub 'Die zu löschende Zeile aus dem Key des Items auslesen. 'Beispiel Key: x25 lngZe = Mid(Me.ListView1.SelectedItem.Key, 2) wksDaten.Activate Range("rngDaten").Rows(lngZe).Activate intAnt = MsgBox( _ "Zeile löschen?" & vbNewLine & vbNewLine & _ "Key: " & Me.ListView1.SelectedItem.Key & vbNewLine & _ "Zeile: " & Mid(Me.ListView1.SelectedItem.Key, 2), vbYesNoCancel) If intAnt = vbYes Then 'erst Zeile in Tabelle löschen Range("rngDaten").Rows(lngZe).Delete 'dann Daten für ListView neu einlesen Call DatenLesen(Range("rngDaten")) End If 'Me.Show End Sub
Private Sub cmbCancel_Click() Unload Me End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) Dim lngSp As Long Tabelle2.Cells.Clear 'Spaltenbreite des ListViews merken 'Wird als Zellkommentar in "rngDaten" eingetragen For lngSp = 1 To Me.ListView1.ColumnHeaders.Count With wksDaten.Range("rngDaten").Cells(1, lngSp) 'Zellkommentar anlegen If .Comment Is Nothing Then .AddComment 'Spaltenbreite eintragen .Comment.Text CStr(Me.ListView1.ColumnHeaders(lngSp).Width) End With 'MsgBox Me.ListView1.ColumnHeaders(lngSp).Position Next lngSp 'Soll keiner die Zellkommentare bearbeiten... 'wksDaten.Visible =xlSheetVeryHidden End Sub

Download:   vba141.zip