AW: Auswahlmöglichkeit in Datenliste
12.01.2015 10:37:40
fcs
Hallo Karlheinz,
irgendwo steckt in der Datei bei Verwendung mit einer der aktuellsten Excelversionen der Wurm drin.
Nach dem Hochladen ist der VBA-Code tot und die Ereignismakros starten nicht bzw. die Listboxen werden im Code nicht erkannt.
Baut man die Datei neu auf, dann funktionierts.
Jedes Tabellenblatt hat nur eine Worksheet_SelectionChange-Ereignisprozedur. In diese muss man alles einbauen, was man abhängig von selektierten Zellen an Ereignissen steuern möchte. In deinem Fall muss eine weiter Case-Zeile für Spalte 3 eingebaut werden. Da der Code für das Positionieren und markieren der Einträge für die beiden Listboxen identisch ist kann man eine separate Sub erstellen mit Listbox und Zelle als Parameter.
Gruß
Franz
'Code für Tabellenblatt mit den 2 Listboxen
Option Explicit
Private bolEinlesen As Boolean
Private Sub ListBox1_Change()
If bolEinlesen = True Then Exit Sub
Dim strText As String
Dim iItem As Integer
'Prüfen, ob Aktive Zelle innerhalb des Ausfüllbereichs der Listbox liegt
Select Case ActiveCell.Column
Case 2 'Spalte B
Select Case ActiveCell.Row
Case Is >= 5
With Me.ListBox1
For iItem = 0 To .ListCount - 1
If .Selected(iItem) = True Then
If strText = "" Then
strText = .List(iItem, 0)
Else
strText = strText & Chr(10) & .List(iItem, 0)
End If
End If
Next
End With
ActiveCell = "'" & strText
Case Else
MsgBox "nur ab Zeile 5 könne per Listbox Werte eingetragen werden"
End Select
Case Else
MsgBox "nur in Spalte 2 ab Zeile 5 könne per Listbox Werte eingetragen werden"
End Select
End Sub
Private Sub ListBox1_LostFocus()
Me.ListBox1.Visible = False
End Sub
Private Sub ListBox2_Change()
If bolEinlesen = True Then Exit Sub
Dim strText As String
Dim iItem As Integer
'Prüfen, ob Aktive Zelle innerhalb des Ausfüllbereichs der Listbox liegt
Select Case ActiveCell.Column
Case 3 'Spalte C
Select Case ActiveCell.Row
Case Is >= 5
With Me.ListBox2
For iItem = 0 To .ListCount - 1
If .Selected(iItem) = True Then
If strText = "" Then
strText = .List(iItem, 0)
Else
strText = strText & Chr(10) & .List(iItem, 0)
End If
End If
Next
End With
ActiveCell = "'" & strText
Case Else
MsgBox "nur ab Zeile 5 könne per Listbox Werte eingetragen werden"
End Select
Case Else
MsgBox "nur in Spalte 3 ab Zeile 5 könne per Listbox Werte eingetragen werden"
End Select
End Sub
Private Sub ListBox2_LostFocus()
Me.ListBox2.Visible = False
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim strText As String
Dim arrText, iItem As Integer, iWerte As Integer
'Zellbereich prüfen, in dem Listbox wirksam sein soll
If Target.Cells.Count = 1 Then
Select Case Target.Column
Case 2 'Spalte B - Listbox1 positionieren, anzeigen und Werte aus aus Zelle einlesen
Select Case Target.Row
Case Is >= 5
Me.ListBox2.Visible = False
Call prcListboxInit(objListbox:=Me.ListBox1, Zelle:=Target)
Case Else
Me.ListBox1.Visible = False
End Select
Case 3 'Spalte C - Listbox2 positionieren, anzeigen und Werte aus aus Zelle einlesen
Select Case Target.Row
Case Is >= 5
Me.ListBox1.Visible = False
Call prcListboxInit(objListbox:=Me.ListBox2, Zelle:=Target)
Case Else
Me.ListBox2.Visible = False
End Select
Case Else
Me.ListBox1.Visible = False
Me.ListBox2.Visible = False
End Select
End If
End Sub
Private Sub prcListboxInit(objListbox As Object, Zelle As Range)
'Listbox positionieren, anzeigen und Werte aus aus Zelle einlesen
Dim arrText, iItem As Integer, iWerte As Integer
Dim strText As String
strText = Zelle.Text
bolEinlesen = True
Application.EnableEvents = False
With objListbox
'Listbox markieren
.Left = Zelle.Offset(0, 1).Left
.Top = Zelle.Top
.Visible = True
'In Zelle vorhandene Werte in Listbox markieren
For iItem = 0 To .ListCount - 1
If .Selected(iItem) = True Then .Selected(iItem) = False
Next
If strText "" Then
arrText = Split(strText, Chr(10))
For iWerte = LBound(arrText) To UBound(arrText)
For iItem = 0 To .ListCount - 1
If CStr(.List(iItem, 0)) = arrText(iWerte) Then
.Selected(iItem) = True
Exit For
End If
Next
Next
End If
End With
Application.EnableEvents = True
bolEinlesen = False
End Sub