AW: Inhalt Listboxes über mehrere Spalten
22.11.2019 10:28:35
fcs
Hallo Wolfgang,
hier der entsprechende Code für dein Userform - einfach den vorhandenen durch diesen Code ersetzen.
LG
Franz
'Code im Userform
Private wksInternExtern As Worksheet
Private Sub prcListbox1_fuellen()
Dim Spalte As Long
Set wksInternExtern = Nothing
If Me.OptionButton1.Value = True Then
Set wksInternExtern = ThisWorkbook.Worksheets("intern")
ElseIf Me.OptionButton2.Value = True Then
Set wksInternExtern = ThisWorkbook.Worksheets("extern")
End If
If Not wksInternExtern Is Nothing Then
With wksInternExtern
Me.ListBox1.ListIndex = -1
Me.ListBox1.Clear
Me.ListBox2.Clear
For Spalte = 1 To .Cells(1, .Columns.Count).End(xlToLeft).Column
Me.ListBox1.AddItem .Cells(1, Spalte).Text
Next
End With
End If
End Sub
Private Sub CommandButton1_Click()
Dim rngZelle As Range
Set rngZelle = ActiveCell
Dim intOffset As Integer, intItem As Integer
If Me.ListBox1.ListIndex = -1 Then
MsgBox "Bitte erst Schulung/Lehrgang in Listbox1 wählen"
Exit Sub
End If
If rngZelle.Value "" Then
If MsgBox("Soll der vorhandene Eintrag überschrieben werden?", _
vbQuestion + vbOKCancel, "Schulung/Lehrgang eintragen") = vbCancel Then
GoTo Beenden
End If
With ActiveSheet
.Range(rngZelle, .Cells(rngZelle.Row, .Columns.Count).End(xlToLeft)).ClearContents
End With
End If
If Me.OptionButton1 = True Then
rngZelle.Value = "intern"
ElseIf Me.OptionButton2 = True Then
rngZelle.Value = "extern"
End If
intOffset = 1
rngZelle.Offset(0, intOffset).Value = Me.ListBox1.Value
With Me.ListBox2
For intItem = 0 To .ListCount - 1
intOffset = intOffset + 1
rngZelle.Offset(0, intOffset).Value = .List(intItem, 0)
Next
End With
Beenden:
Unload Me
End Sub
Private Sub CommandButton2_Click()
Unload Me
End Sub
Private Sub ListBox1_Change()
Me.ListBox2.Clear
If Me.ListBox1.ListIndex = -1 Then
Else
Spalte = Me.ListBox1.ListIndex + 1
With wksInternExtern
For zeile = 2 To .Cells(.Rows.Count, Spalte).End(xlUp).Row
Me.ListBox2.AddItem .Cells(zeile, Spalte).Text
Next
End With
End If
End Sub
Private Sub OptionButton1_Click()
Call prcListbox1_fuellen
End Sub
Private Sub OptionButton2_Click()
Call prcListbox1_fuellen
End Sub
Private Sub UserForm_Activate()
'ggf. vorhandene Einträge aus Tabelle in userform übernehmen
Select Case ActiveCell.Text
Case ""
'neuer Eintrag
Exit Sub
Case "intern"
Me.OptionButton1 = True
Me.ListBox1 = ActiveCell.Offset(0, 1).Text
Case "extern"
Me.OptionButton2 = True
Me.ListBox1 = ActiveCell.Offset(0, 1).Text
Case Else
MsgBox "Inhalt der gewählten Zelle ist nicht ""intern"" oder ""extern"""
Exit Sub
End Select
End Sub