Setzen Sie auch das Microsoft ListView-Control ein? Ist ja schließlich ein hervorragendes Control, um mal eben schnell eine mehrspaltige Liste zu erstellen. In einem unserer früheren Extra-Tipps haben wir Ihnen gezeigt, wie man solche mehrspaltigen Einträge mit nur einer Anweisung schnell hinzufügen kann. Was aber nun, wenn man zwei (mehrspaltige) Einträge miteinander vertauschen will oder einfach nur den gerade selektierten Eintrag per Buttonclick nach oben oder nach unten verschieben möchte? Klar, man könnte jetzt hergehen und den zu verschiebenden Eintrag zunächst aus der Liste löschen, um ihn dann an der gewünschten Position neu einzufügen. Das gleiche dann für den zweiten Eintrag, was sich auch alles noch in Grenzen hält, solange es sich nicht um mehrspaltige Einträge handelt und keinerlei Icons (Symbole) und Farb-Einstellungen berücksichtigt werden müssen. Wie Sie es aber vom vb@rchiv gewohnt sind, haben wir auch für dieses Problem wieder einmal einen passenden Tipp (Code) parat Vorgehensweise: Das ganze sieht dann so aus: ' UDT - Benutzerdefinierte Datentypen ' zum Speichern eines ListView-Items Private Type UDT_SubItem Bold As Boolean ForeColor As Long Key As String ReportIcon As Long Tag As Variant Text As String ToolTipText As String End Type Private Type UDT_ListItem Bold As Boolean Checked As Boolean ForeColor As Long Ghosted As Boolean Icon As Long Key As String Selected As Boolean SmallIcon As Long Tag As Variant Text As String ToolTipText As String SubItems() As UDT_SubItem End Type ' Zwei ListView-Items miteinander vertauschen Private Sub lvwSwap(itemX As ListItem, itemY As ListItem) Dim UDT_ItemX As UDT_ListItem Dim UDT_ItemY As UDT_ListItem Dim sKey As String ' List-Items in UDT-Datentyp speichern UDT_ItemX = lvwItem_To_UDT(itemX) UDT_ItemY = lvwItem_To_UDT(itemY) ' Achtung! Key-Wert muss temporär geändert, da es ' sonst zum Fehler "Doppelter schlüssel in Auflistung" ' kommen kann sKey = UDT_ItemY.Key: UDT_ItemY.Key = "~temp" ' ItemX und ItemY vertauschen lvwUDT_To_Item itemX, UDT_ItemY lvwUDT_To_Item itemY, UDT_ItemX ' Key-Werte wiederherstellen itemX.Key = sKey End Sub ' Kopie eines LisView-Items erstellen Private Function lvwItem_To_UDT(oItem As ListItem) _ As UDT_ListItem Dim I As Integer With lvwItem_To_UDT ' Eigenschaften .Bold = oItem.Bold .Checked = oItem.Checked .ForeColor = oItem.ForeColor .Ghosted = oItem.Ghosted .Icon = oItem.Icon .Key = oItem.Key .Selected = oItem.Selected .SmallIcon = oItem.SmallIcon .Tag = oItem.Tag .Text = oItem.Text .ToolTipText = oItem.ToolTipText ' SubItems ReDim .SubItems(oItem.ListSubItems.Count) For I = 1 To oItem.ListSubItems.Count With .SubItems(I) .Bold = oItem.ListSubItems(I).Bold .ForeColor = oItem.ListSubItems(I).ForeColor .Key = oItem.ListSubItems(I).Key .ReportIcon = oItem.ListSubItems(I).ReportIcon .Tag = oItem.ListSubItems(I).Tag .Text = oItem.ListSubItems(I).Text .ToolTipText = oItem.ListSubItems(I).ToolTipText End With Next I End With End Function ' UDT-Datentyp nach Item Private Sub lvwUDT_To_Item(oItem As ListItem, _ UDT_Item As UDT_ListItem) Dim I As Integer With UDT_Item ' Eigenschaften oItem.Bold = .Bold oItem.Checked = .Checked oItem.ForeColor = .ForeColor oItem.Ghosted = .Ghosted oItem.Icon = .Icon oItem.Key = .Key oItem.Selected = .Selected oItem.SmallIcon = .SmallIcon oItem.Tag = .Tag oItem.Text = .Text oItem.ToolTipText = .ToolTipText ' SubItems For I = 1 To oItem.ListSubItems.Count With .SubItems(I) oItem.ListSubItems(I).Bold = .Bold oItem.ListSubItems(I).ForeColor = .ForeColor oItem.ListSubItems(I).Key = .Key oItem.ListSubItems(I).ReportIcon = .ReportIcon oItem.ListSubItems(I).Tag = .Tag oItem.ListSubItems(I).Text = .Text oItem.ListSubItems(I).ToolTipText = .ToolTipText End With Next I End With End Sub Vertauschen zweier ListView-Einträge ' nach oben verschieben Private Sub lvw_MoveUp() Dim oItem_x As ListItem Dim oItem_y As ListItem Dim Index As Integer With ListView1 If Not .SelectedItem Is Nothing Then Index = .SelectedItem.Index If Index > 1 Then Set oItem_x = .ListItems(Index) Set oItem_y = .ListItems(Index - 1) lvwSwap oItem_x, oItem_y End If End If End With End Sub ' nach unten verschieben Private Sub lvw_MoveDown() Dim oItem_x As ListItem Dim oItem_y As ListItem Dim Index As Integer With ListView1 If Not .SelectedItem Is Nothing Then Index = .SelectedItem.Index If Index < .ListItems.Count Then Set oItem_x = .ListItems(Index) Set oItem_y = .ListItems(Index + 1) lvwSwap oItem_x, oItem_y End If End If End With End Sub Private Sub cmdUp_Click() lvw_MoveUp End Sub Private Sub cmdDown_Click() lvw_MoveDown End Sub |