AW: Dropdown mit Mehrfachauswahl auslesen
11.08.2020 00:28:40
monnem2007
Ich bitte um Nachsicht - ich kenne die "Gewohnheiten" in diesem Forum nicht.
Das ist der Code, den ich bisher versucht habe - Achtung: aus Unwissenheit habe ich in Foren/Tutorien nach passenden Codes gesucht, die hier auch vorkommen!
Private Sub UserForm_Initialize()
'Soll die Multiauswahl im Listenfeld ermöglichen - unklar, ob für Tabelle oder vba geeignet!
'unklar, ob nachstehende Teilen erforderlich
Dim lngSpalteMax As Long
Dim rngBereich As Range
'Soll die Anwendung des Codes aus Excel # 396 - Mehrfachauswahl bei Datenüberprüfung - VBA für _
mehrere Listenfelder/DropDwn ermöglichen - unklar, ob auch vba!!!!
' If Not Application.Intersect(Target, Range("G4:I58,J4:J58,M4:M58")) Is Nothing Then
'Soll die Multiauswahl nun direkt ermöglichen!
'Me.Caption = Gesamtzustand
'With Me.Gesamtzustand
'.ColumnCount = lngSpalteMax
'.List = Application.Transponse(rngBereich.Value)
'.MultiSelect = fmMultiSelectMulti - Da stimmt etwas nicht!
'End With
End Sub
Private Sub ButtonMaskeschließen_Click()
'Maske schließen ohne zu speichern
Unload EingabeReclam
End Sub
Private Sub ButtonÜbernehmen_Click()
'Daten der aktiven Maske in das Arbeitsblatt übernehmen
'Übernahme verhindern, wenn keine Auswahl Bestand oder Neuerwerb getroffen und ggf. Warnbox _
anzeigen
If KlickBestand = False And KlickNeuerwerb = False Then
MsgBox "Treffen Sie eine Auswahl, ob es sich um ein Heft im Bestand oder einen Neuerwerb _
handelt!"
Else
'Springt damit zur letzten Zeile (Bestandsliste) und erhöht um 1 für neuen Eintrag
Dim last As Integer
If KlickBestand = True And KlickNeuerwerb = False Then
last = Worksheets("Bestand").Cells(Rows.Count, 6).End(xlUp).Row + 1
'Die einzelnen Befehle übertragen die Maskeneingabe in die jeweilige Spalte der letzten Zeile _
im Blatt Bestand
'!!!Für Optionsfelder noch bearbeiten!!!
Worksheets("Bestand").Cells(last, 1).Value = "X"
Worksheets("Bestand").Cells(last, 2).Value = ""
'Für "Doppel" siehe nachstehende IF-Ausführung
Worksheets("Bestand").Cells(last, 4).Value = EingabeReclam.Band.Value
Worksheets("Bestand").Cells(last, 5).Value = EingabeReclam.Autor.Value
Worksheets("Bestand").Cells(last, 6).Value = EingabeReclam.Titel.Value
Worksheets("Bestand").Cells(last, 7).Value = EingabeReclam.Jahrgang.Value
Worksheets("Bestand").Cells(last, 8).Value = EingabeReclam.BeschreibungVersion.Value
Worksheets("Bestand").Cells(last, 9).Value = EingabeReclam.Gesamtzustand.Value
Worksheets("Bestand").Cells(last, 10).Value = EingabeReclam.Einband.Value
Worksheets("Bestand").Cells(last, 11).Value = EingabeReclam.Innenseiten.Value
Worksheets("Bestand").Cells(last, 12).Value = EingabeReclam.Beschriftung.Value
'Eintrag von Doppel oder leeres Feld
If Doppel = False Then
Worksheets("Bestand").Cells(last, 3).Value = ""
Else
Worksheets("Bestand").Cells(last, 3).Value = "X"
End If
End If
'Und das selbe für den Übertrag in die Neuerwerbsliste
If KlickBestand = False And KlickNeuerwerb = True Then
last = Worksheets("Neuerwerbungen").Cells(Rows.Count, 6).End(xlUp).Row + 1
Worksheets("Neuerwerbungen").Cells(last, 1).Value = ""
Worksheets("Neuerwerbungen").Cells(last, 2).Value = "X"
'Für "Doppel" siehe nachstehende IF-Ausführung
Worksheets("Neuerwerbungen").Cells(last, 4).Value = EingabeReclam.Band.Value
Worksheets("Neuerwerbungen").Cells(last, 5).Value = EingabeReclam.Autor.Value
Worksheets("Neuerwerbungen").Cells(last, 6).Value = EingabeReclam.Titel.Value
Worksheets("Neuerwerbungen").Cells(last, 7).Value = EingabeReclam.Jahrgang.Value
Worksheets("Neuerwerbungen").Cells(last, 8).Value = EingabeReclam.BeschreibungVersion.Value
Worksheets("Neuerwerbungen").Cells(last, 9).Value = EingabeReclam.Gesamtzustand.Value
Worksheets("Neuerwerbungen").Cells(last, 10).Value = EingabeReclam.Einband.Value
Worksheets("Neuerwerbungen").Cells(last, 11).Value = EingabeReclam.Innenseiten.Value
Worksheets("Neuerwerbungen").Cells(last, 12).Value = EingabeReclam.Beschriftung.Value
'Eintrag von Doppel oder leeres Feld
If Doppel = False Then
Worksheets("Neuerwerbungen").Cells(last, 3).Value = ""
Else
Worksheets("Neuerwerbungen").Cells(last, 3).Value = "X"
End If
End If
'Entfernt die Daten aus den Formularfeldern für den nächsten Eintrag
KlickBestand = False
KlickNeuerwerb = False
Doppel = False
Band = ""
Autor = ""
Titel = ""
Jahrgang = ""
BeschreibungVersion = ""
Gesamtzustand = ""
Einband = ""
Innenseiten = ""
Beschriftung = ""
End If 'Von Abfrage, ob Bestand/Neuerwerb gesetzt ist
End Sub
Private Sub Gesamtzustand_DropButtonClick()
Gesamtzustand.RowSource = "DropGesamtzustand"
End Sub
Private Sub Gesamtzustand_Change()
End Sub
Private Sub Einband_DropButtonClick()
Einband.RowSource = "DropEinband"
End Sub
Private Sub Einband_Change()
End Sub
Private Sub Innenseiten_DropButtonClick()
Innenseiten.RowSource = "DropInnenseiten"
End Sub
Private Sub Innenseiten_Change()
End Sub
Private Sub Beschriftung_DropButtonClick()
Beschriftung.RowSource = "DropBeschriftung"
End Sub
Private Sub Beschriftung_Change()
End Sub
Private Sub UserForm_Click()
End Sub