Dropdown Wert auslesen

Hallo,
ich soll für einen Freund eine Übersicht über eine Liste erstellen.
Die Liste hat für einzelne Punkte ein Dropdown Menü mit den Kriterien grün, gelb, rot, nicht relevant.
Diese Farben stehen als Text im Menü und die Farbe ändert sich bei der Auswahl.
Wenn die Farbe rot oder gelb in der Zelle ist, soll die ganze Zeile in das Tabellenblatt Übersicht kopiert werden. Ich schaff es leider nicht den Wert aus dem Dropdown Menü auszulesen. Kann mir bitte Jemand helfen?
Mein aktueller Code lautet:

Sub MakroUebersicht() Dim Zelle As Range Dim i As Long 'i = Zeile i = 4 For Each Zelle In Sheets("RG2 (Vergabe)").Range("G" & i, "G999") If Sheets("RG2 (Vergabe)").DrawingObjects("Dropdown 618").Text = "rot" or DrawingObjects(" _ Dropdown 618").Text = "gelb" Then 'wenn die Zelle die Farbe rot oder gelb trägt, Sheets("RG2 (Vergabe)").Range("A" & i - 1, "N" & i).Copy 'wird die jeweilige Zelle kopiert With Sheets("Übersicht") leereZeile = .Cells(.Rows.Count, 1).End(xlUp).Row + 1 leereZeile = WorksheetFunction.Max(5, leereZeile) .Cells(leereZeile, 1).PasteSpecial 'fügt die kopierte Zeile in die letzte leere Zeile des Tabellenblattes Übersicht ein End With Rows(i).Select Rows(i).EntireRow.AutoFit i = i + 1 End If Next End Sub

Es kommt immer der Laufzeitfehler 1004 "Die DrawingObjects-Eigenschaft des Worksheet Objektes kann nicht zugeordnet werden" Was mach ich falsch?
Danke
Gruß
Franzi

Hallo Franzi,
eine Möglichkeit, warum der Fehler noch auftreten kann: In dem DropDown wurde noch kein Eintrag gewählt.
Ich hab das Makro mit einer entsprechenden Prüfung und Meldung versehen.
Zusätzliche Anpassungen:
- letzte zu prüfende/kopierende Zeile wird variabel gesucht.
- Bildschirmaktualiiserung wird während der Makroausführung deaktiviert.
Gruß
Franz

Sub MakroUebersicht()
Dim Zelle As Range
Dim i As Long 'i = Zeile
Dim leereZeile As Long, oShape As Shape
Dim wert, wert2
i = 4
With Sheets("RG2 (Vergabe)")
Application.ScreenUpdating = False
For Each Zelle In .Range(.Cells(i, 7), .Cells(.Rows.Count, 1).End(xlUp).Offset(0, 6))
Set oShape = .Shapes("Dropdown 618")
With oShape.ControlFormat
wert = .Value 'Indexwert des ausgewählten Listenwertes
If .ListIndex = 0 Then
MsgBox "Kein Wert ausgewählt in """ & oShape.Name & """!"
GoTo Beenden
Else
wert2 = .List(.Value) 'ausgewählter Listenwert
End If
End With
If wert2 = "rot" Or wert2 = "gelb" Then
'wenn die Zelle die Farbe rot oder gelb trägt,
.Range("A" & i - 1, "N" & i).Copy 'wird die jeweilige Zelle kopiert
With Sheets("Übersicht")
leereZeile = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
leereZeile = WorksheetFunction.Max(5, leereZeile)
.Cells(leereZeile, 1).PasteSpecial
'fügt die kopierte Zeile in die letzte leere Zeile des Tabellenblattes Übersicht  _
ein
End With
Rows(i).Select
Rows(i).EntireRow.AutoFit
i = i + 1
End If
Next
End With
Beenden:
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Forumthread: Dropdown Wert auslesen

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Infobox / Tutorial