AW: ListBoxen-Schaltung
08.02.2026 19:35:26
Alwin Weisangler
hier vorsorglich nochmals der komplette Code fürs Userform:
Option Explicit
Private j&, iLz&, bo As Boolean, tmp$
Private Sub Label1_Click()
Dim i&, Zeile&
Zeile = 28
With Tabelle1
.Range("E14").Value = ListBox1.List(ListBox1.ListIndex, 5) ' Firma-Name
.Range("E15").Value = ListBox1.List(ListBox1.ListIndex, 6) ' Firma-Zusatz
.Range("E16").Value = ListBox1.List(ListBox1.ListIndex, 2) ' Anrede
.Range("G16").Value = ListBox1.List(ListBox1.ListIndex, 3) & " " & ListBox1.List(ListBox1.ListIndex, 4) ' Vorname, Nachname
.Range("E17").Value = ListBox1.List(ListBox1.ListIndex, 7) ' Strasse, Hausnummer
.Range("E18").Value = ListBox1.List(ListBox1.ListIndex, 8) ' Adresse (zweite Zeile)
.Range("E19").Value = ListBox1.List(ListBox1.ListIndex, 9) ' Plz, Ort
.Range("AM19").Value = ListBox1.List(ListBox1.ListIndex, 1) ' Kundennummer
.Range("E29:AC43,AH29:AM43").ClearContents
For i = 1 To ListBox2.ListCount
If ListBox2.Selected(i - 1) Then
Zeile = Zeile + 1
.Range("G" & Zeile) = ListBox2.List(i - 1, 1)
.Range("AH" & Zeile) = ListBox2.List(i - 1, 6)
End If
Next i
End With
End Sub
Private Sub UserForm_Activate()
Label1.Enabled = False
Label1.Caption = "Einen Empfänger und bis zu 15 Artikelpositionen markieren danach hier betätigen"
End Sub
Private Sub Verarbeiten()
Dim i&, k&
If ListBox1.ListIndex = -1 And j = 0 Then
Label1.Enabled = False
ElseIf ListBox1.ListIndex = -1 And j > 0 Then
Label1 = "Einen Empfänger wählen"
Label1.Enabled = False
ElseIf ListBox1.ListIndex > -1 And j = 0 Then
Label1 = "Artikel bis zu 15 Positionen wählen"
Label1.Enabled = True
Else
Label1 = tmp
Label1.Enabled = True
End If
If j > 15 Then
MsgBox "Es sind nur 15 Positionen zulässig. Die letzte Position wird zurückgesetzt.", vbExclamation, "Maximale Anzahl Positionen sind überschritten"
bo = True
ListBox2.Selected(iLz) = False
End If
j = 0
End Sub
Private Sub ListBox1_Click()
Dim i&, arr(): arr = Array(5, 7, 9, 3, 4)
With ListBox1
For i = LBound(arr) To UBound(arr)
tmp = tmp & .List(.ListIndex, arr(i)) & ", "
Next i
tmp = Left(tmp, Len(tmp) - 2) & " einfügen"
End With
Verarbeiten
End Sub
Private Sub ListBox2_Change()
Dim i&
If bo = True Then
bo = False
Exit Sub
End If
With ListBox2
For i = 0 To .ListCount - 1
If .Selected(i) Then j = j + 1
Next i
End With
iLz = ListBox2.ListIndex
Verarbeiten
End Sub
Private Sub UserForm_Initialize()
Dim Z As Range
Dim Elt
Dim Rng As Range
Dim LetzteSpalte As Long
Dim BreitenListe As String
For Each Elt In Array(Array("Adressen", "ListBox1"), Array("Artikel", "ListBox2"))
With Worksheets(Elt(0))
BreitenListe = ""
Set Rng = .Range(.Range("A2"), .Range("XFD2").End(xlToLeft))
For Each Z In Rng.Cells
BreitenListe = BreitenListe & ";" & (Z.Width + 50)
Next
Set Rng = .Range(Rng, .Range("A9999").End(xlUp))
End With
With Me.Controls(Elt(1))
.ColumnHeads = True
.ColumnCount = Rng.Columns.Count
.RowSource = Elt(0) & "!" & Rng.Address
.ColumnWidths = Mid(BreitenListe, 2)
End With
Set Rng = Nothing
Next
End Sub
Gruß Uwe