Zellen für DropDown Menü definieren
13.12.2013 08:38:18
Chris
ich habe folgenden Code im Netz gefunden den ich gerne verwenden möchte.
Nun soll der Code so modifiziert werden das nur in bestimmten Zellen das DropDown Menü auftraucht.
IST: Aktuell erscheint es in allen Zellen von Spalte B:E.
SOLL: Das DropDown soll nur in den Zellen C1, C2, C11 und C13 erscheinen.
Kann mir diesbezüglich jemand helfen?
Vielen Dank :)
Dim sWert As Variant
Private Sub lblÜbernhemen_Click()
Dim t As Single
lblÜbernhemen.SpecialEffect = fmSpecialEffectSunken
t = Timer: Do Until Timer > t + 0.1: DoEvents: Loop
lbWahl.TopLeftCell.Offset(-1) = sWert
lblÜbernhemen.SpecialEffect = fmSpecialEffectRaised
End Sub
Private Sub lbWahl_Change()
Dim i As Long
With lbWahl
If .ListCount Then
sWert = Empty
For i = 0 To .ListCount - 1
If .Selected(i) Then
sWert = sWert & ";" & .List(i, 0)
End If
Next
If sWert "" Then sWert = Mid(sWert, 2)
End If
End With
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim intSpalte As Integer
If Not Intersect(Target, Range("B:E")) Is Nothing And Target.Row > 1 Then
sWert = Empty
With Target.Cells(1)
lbWahl.Left = .Left
lbWahl.Top = .Offset(1).Top
lblÜbernhemen.Left = .Left
lblÜbernhemen.Top = .Offset(1).Top + lbWahl.Height + 1
intSpalte = WorksheetFunction.Match(Cells(1, .Column), Tabelle2.Rows(1), 0)
End With
With Tabelle2
lbWahl.List = .Range(.Cells(1, intSpalte), .Cells(.Rows.Count, intSpalte).End(xlUp)) _
.Value
End With
lbWahl.Visible = True
lblÜbernhemen.Visible = True
Else
lbWahl.Visible = False
lblÜbernhemen.Visible = False
End If
End Sub
Anzeige