AW: Werte aus Listbox in aktive Zelle eintragen
17.06.2006 12:46:49
fcs
Hallo Christoph,
Listboxen (Erzeugt mit der Symbolleiste "Steuerelement-Toolbox") übertragen den ausgewählten Wert in die unter Eigenschaft "LinkedCell" eingetragene Zelle. Listboxen mit Mehrfachauswahl übertragen keinen Wert in die "LinkedCell".
Hier muss man per Makro nachhelfen. Leider funktioniert der Eintrag in die aktive Zelle der Tabelle auch nicht einfach, da in Excel immmer nur ein Element aktiv sein kann und solange die Listbox aktiv ist, gibt es keine aktive Zelle.
Deshalb sind ein paar Umwege notwendig, um aktive Zelle und Listbox-Auswahl zu verbinden.
So wie du deine Frage gestellt hast, möchtest du in verschiedenen Zellen die in der Liste ausgewählten Werte eintragen.
Bei meiner Lösung wird die Adresse der selektierten/aktiven Zelle als LinkedCell für die Listbox festgelegt. Dabei müssen die selektierten Zellen in einem bestimmten Zellbereich sein. Sind in der aktiven Zelle schon Einträge vorhanden, dann werden diese in der Listbox markiert. Gleichzeitig wird die Listbox immer rechts neben der gewählten Zelle positioniert. Wird eine Zelle außerhalb des vorgegebene Bereichs gewählt, dann wird die Listbox ausgeblendet.
Den nachfolgenden Code im VBA.Editor unter der Tabelle einfügen in der sich die Listbox befindet. Den Zellbereich anpassen und ggf. die Bezeichnung der Listbox.
'Auswahl in einer Listbox mit Mehrfachauswahl in eine Zelle übertragen
Dim AendernLB1 As Boolean 'Change-Ereignis der Listbox1 steuern
Private Sub ListBox1_Change()
With ListBox1
If .LinkedCell = "" Or AendernLB1 = False Then Exit Sub
Dim I As Integer
Dim Auswahl As String, Sep As String
Sep = " : " 'Trennzeichen zwischen den Werten
For I = 0 To .ListCount - 1
If .Selected(I) = True Then
If Auswahl = "" Then
Auswahl = .List(I)
Else
Auswahl = Auswahl & Sep & .List(I)
End If
End If
Next I
ActiveSheet.Range(.LinkedCell).Value = Auswahl
End With
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim Wert, I As Integer, J As Integer, Sep As String, Werte() As String
' In der nächsten Zeile den Zellbereich festlegen in dem die Listbox wirksam sein soll
If Not Intersect(Target, ActiveSheet.Range("B2:B21")) Is Nothing And Target.Cells.Count = 1 Then
Wert = Target.Value
Target.ClearContents ' erforderlich, da bei gefüllten Zellen sonst Fehlermeldung bei Multiselectbox
With ListBox1
.LinkedCell = Target.Address
' Listbox rechts neben der aktiven Zelle positionieren
.Top = Target.Top
.Left = Target.Offset(0, 1).Left
' Auswahlliste an Zellwert anpassen
Target.Value = Wert
AendernLB1 = False 'Schalter setzen, damit Change-Ereignis der Listbox nicht ausgeführt wird
For I = 0 To .ListCount - 1
.Selected(I) = False
Next
.Visible = True
If Not IsEmpty(Target) Then
'Werte ermitteln
ReDim Werte(0 To .ListCount - 1)
Sep = " : " 'Trennzeichen zwischen den Werten
I = 0
Do Until InStr(1, Wert, Sep) = 0
Werte(I) = Left(Wert, InStr(1, Wert, Sep) - 1)
Wert = Mid(Wert, InStr(1, Wert, Sep) + Len(Sep))
I = I + 1
Loop
Werte(I) = Wert
'Werte in Liste markieren
For I = 0 To .ListCount - 1
If Werte(I) = "" Then Exit For
For J = 0 To .ListCount - 1
If Werte(I) = .List(J) Then
.Selected(J) = True
End If
Next J
Next I
End If
AendernLB1 = True 'Change-Ereignis der Listbox wieder aktivieren
' Listbox einblenden
End With
Else
With ListBox1
.LinkedCell = "" 'keine Zelle der Listbox zuordnen
.Visible = False ' Listbox ausblenden
End With
End If
End Sub
Beispieldatei: Die Datei https://www.herber.de/bbs/user/34439.xls wurde aus Datenschutzgründen gelöscht
mfg
Franz