VBA Multiple List Box Auswahlen in Tabelle
30.10.2018 16:25:44
Anne
ich muss gerade ein ausführliches Standnotizen-Formular für eine Messe ausarbeiten.
An einer Stelle des Formulars müssen unsere Vertriebler ausfüllen, welche Prospektmaterialien dem Interessenten zugeschickt werden sollen. Es gibt also eine Mehrfachauswahl. Ich hätte das gern mit einer Multiple List Box Auswahl gemacht und dafür folgenden Code verwendet (siehe unten). Jetzt kann ich zwar in der Vorschau die Prospekte super zur zweiten Listbox hinzufügen. Aber wie bekomme ich denn jetzt die Daten, die in ListBox2 sind in meine Tabelle gefüllt?
Danke für eure Hilfe!!!
With ListBox1
.AddItem "Imagebroschüre - Heidrive Motion"
.AddItem "Imagebroschüre - Pasotec"
.AddItem "Servomotoren - Katalog HeiMotion Premium"
.AddItem "Servomotoren - Katalog HeiMotion Dynamic"
.AddItem "Servomotoren - Katalog HeiMotion Compact"
.AddItem "Servomotoren - Katalog EC-/BLDC Motoren"
.AddItem "Servomotoren - Flyer DSL - Einkabellösung"
.AddItem "Servomotoren - Flyer HMD04"
.AddItem "Servomotoren - Flyer HMD10"
.AddItem "Asynchronmotoren - Katalog Motorenprogramm"
.AddItem "Motoren mit integrierter Elektronik - Prospekt HeiMotion integriert"
.AddItem "Motoren mit integrierter Elektronik - Flyer EC-Compact"
.AddItem "Motoren mit integrierter Elektronik - Flyer HMPi04"
.AddItem "Motoren mit integrierter Elektronik - Flyer Servotechnologie Robotik"
.AddItem "Elektronik - Katalog Reglerprogramm"
.AddItem "Elektronik - Flyer HES/HEM Geber"
.AddItem "Elektronik - Flyer SIL Geber"
.AddItem "Elektronik - Flyer HCD"
.AddItem "Getriebemotoren - Katalog Planetengetriebe (HMPG)"
.AddItem "Getriebemotoren - Katalog Planetengetriebe (HMDG)"
.AddItem "Getriebemotoren - Katalog Stirnkegelrad-/Schneckengetriebe"
.AddItem "Getriebemotoren - Katalog Stirnradgetriebe"
.AddItem "Getriebemotoren - Prospekt Flachgetriebe"
.AddItem "Getriebemotoren - Flyer Getriebemotoren Compact"
.AddItem "Getriebemotoren - Flyer AGVs"
End With
obShift.Value = True
End Sub
Private Sub cmdHinzufügen_Click()
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) = True Then ListBox2.AddItem ListBox1.List(i)
Next i
End Sub
Private Sub cmdLöschen_Click()
Dim counter As Integer
counter = 0
For i = 0 To ListBox2.ListCount - 1
If ListBox2.Selected(i - counter) Then
ListBox2.RemoveItem (i - counter)
counter = counter + 1
End If
Next i
cbKataloge.Value = False
End Sub
Private Sub obEinzelauswahl_Click()
ListBox1.MultiSelect = 0
ListBox2.MultiSelect = 0
End Sub
Private Sub obKataloge_Click()
ListBox1.MultiSelect = 1
ListBox2.MultiSelect = 1
End Sub
Private Sub obShift_Click()
ListBox1.MultiSelect = 2
ListBox2.MultiSelect = 2
End Sub
Private Sub CheckBox1_Click()
If CheckBox1.Value = True Then
For i = 0 To ListBox1.ListCount - 1
ListBox1.Selected(i) = True
Next i
End If
If CheckBox1.Value = False Then
For i = 0 To ListBox1.ListCount - 1
ListBox1.Selected(i) = False
Next i
End If
End Sub
Private Sub CheckBox2_Click()
If CheckBox2.Value = True Then
For i = 0 To ListBox2.ListCount - 1
ListBox2.Selected(i) = True
Next i
End If
If CheckBox2.Value = False Then
For i = 0 To ListBox2.ListCount - 1
ListBox2.Selected(i) = False
Next i
End If
End Sub
Anzeige
