Listbox mit Multiselect und Copy to Clipboard
17.11.2017 10:09:29
EtoPHG
Hallo zusammen,
Hier ist der Code für eine Userform, die ledglich eine Listbox-Control und ein Label-Control enthält:
ListBox1 mit der Eigenschaft MultiSelect = 2 - fmMultiSelectExtended
Die Listbox kann auch mehrere Spalten enthalten. ColumnCount > 1
Mit gehaltener Ctrl-Taste und Mausklick auf die Zeile können mit der Maus einzelne Zeilen dazuselektiert, oder bereits selektierte abgewählt werden.
Wenn in der Listbox Ctrl-C (Copy) gedrückt wird, werden alle selektierten Zeilen (und Spalten) ins Clipboard kopiert.
Label1
Das Label dient nur zur Information und Anzeige von Anzahl Einträgen, Selektierten Einträgen und Copy-Info
Das Label und dazugehörige Codezeilen mit Label1. können auch entfernt werden.
Option Explicit
Dim lbxR As Integer
Dim lbxC As Integer
Dim clipObject As New DataObject
Private Sub ListBox1_Change()
Dim lbxCnt As Integer
With ListBox1
For lbxR = 0 To .ListCount - 1
If .Selected(lbxR) Then lbxCnt = lbxCnt + 1
Next lbxR
End With
Label1.Caption = lbxCnt & " Einträge der Listbox sind ausgewählt"
End Sub
Private Sub ListBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Dim copyText As String
If (KeyCode = 99 Or KeyCode = 67) And Shift = 2 Then
With ListBox1
For lbxR = 0 To .ListCount - 1
If .Selected(lbxR) Then
For lbxC = 0 To .ColumnCount - 1
copyText = copyText & .List(lbxR, lbxC) & vbTab
Next lbxC
copyText = Left(copyText, Len(copyText) - 1) & vbCrLf
End If
Next lbxR
End With
End If
If copyText "" Then
clipObject.SetText copyText
clipObject.PutInClipboard
Label1.Caption = "Selection copied to clipboard"
End If
End Sub
Private Sub UserForm_Initialize()
With ListBox1
.Clear
For lbxR = 1 To 10
.AddItem "Eintrag Zeile " & lbxR
For lbxC = 1 To .ColumnCount - 1
.List(lbxR - 1, lbxC) = "Spalte " & lbxC + 1
Next lbxC
Next lbxR
.ListIndex = 0
Label1.Caption = "Listbox enthält " & .ListCount & " Zeilen-Einträge"
End With
End Sub
Spielt mal damit rum ;-)
Gruess Hansueli