AW: Dynamische Listbox an verbundenen Zellen
29.09.2012 17:29:03
fcs
Hallo Lars,
mit den folgenden Anpassungen können auch verbunden Zellen bearbeitet werden.
Gruß
Franz
Option Explicit
'Auswahl in einer Listbox mit Mehrfachauswahl in eine Zelle übertragen
Dim AendernLB1 As Boolean 'Change-Ereignis der Listbox1 steuern
Private Const Sep As String = " : " 'Trennzeichen zwischen den Werten
Private Sub ListBox1_Change()
Dim I As Integer
Dim Auswahl As String
With ListBox1
If .LinkedCell = "" Or AendernLB1 = False Then Exit Sub
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).Cells(1, 1).Value = Auswahl
End With
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim Wert, I As Integer, J As Integer, 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 Or Target.MergeCells = True) Then
Wert = Target.Cells(1, 1).Value
Target.ClearContents ' erforderlich, da bei gefüllten Zellen sonst Fehlermeldung bei _
Multiselectbox
With ListBox1
.LinkedCell = Target.Cells(1, 1).Address
' Listbox rechts neben der aktiven Zelle positionieren
.Top = Target.Cells(1, 1).Top
.Left = Target.Cells(1, 1).Offset(0, 1).Left
' Auswahlliste an Zellwert anpassen
Target.Cells(1, 1).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)
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