AW: ComboBox mit Daten füllen
01.11.2016 11:35:05
Martin
Hallo Hajo,
in D4 soll dann der Wert aus der Combobox stehen der wiederrum aus einer Liste in Tabelle1 steht. Dies soll dann von D4 -AH4 so funzen.
Der Code den ich z.Zt. verwende funzt nicht, irgendwie hat das wohl mit Datum oder so zutun:
Die Combobox wird aufgerufen und füllt sich auch mit Daten.
An folgender Stelle bleibt er stehen.(wird gelb markiert)
Ich schätze mal das meine "Liste" nicht so liegt, wie die in diesem Code.
Range(DropDownZoom.TopLeftCell.Address) = _
Range(DropDownZoom.ListFillRange).Cells(DropDownZoom.ListIndex + 1)
Option Explicit ' Variablendeklaration erforderlich
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim oobElement As OLEObject ' Variable für das Steuerelement als OLEObject
On Error Resume Next
ActiveSheet.OLEObjects("DropDownZoom").Delete
On Error GoTo 0
If Not Intersect(Target, Range("D3:AH3")) Is Nothing Then
' Bildschirmaktualisierung aus
Application.ScreenUpdating = False
' ComboBox erstellen
Set oobElement = OLEObjects.Add(ClassType:="Forms.ComboBox.1", Left:=0, Top:=0, Width:= _
0, Height:=0)
With oobElement
.Top = ActiveCell.Top ' Position oben
.Left = ActiveCell.Left ' Position links
.Width = Range(ActiveCell, ActiveCell.Offset(0, 1)).Width ' Breite
.Height = Range(ActiveCell, ActiveCell.Offset(1, 0)).Height ' Höhe
.ListFillRange = "Liste" ' Quellbereich, per Name "Liste" definiert
.Name = "DropDownZoom" ' Name zuweisen
.Object.MatchRequired = True ' nur vorhandene Einträge
.Object.ListRows = 14 ' Zeilenanzahl der Liste
.Object.Font.Size = 12 ' Schriftgröße
.Object.DropDown ' DropDown öffnen
.Object.ListIndex = 0 ' 1. Eintrag auswählen
' Umwandeln in ein Datum - nur erforderlich wenn die Auswahl aus Datumswerten _
besteht
'If IsDate(Range(.ListFillRange).Cells(1)) Then .Object = CStr(CDate(.Object))
.Activate ' aktivieren
' erforderlich, da andernfalls der 1. Eintrag nicht in die Zelle eingetragen werden _
kann,
' weil seine Auswahl kein Change-Ereignis auslöst da er bereits ausgwählt ist
' mit dem Makro "Eintrag" wird der 1. Eintrag in die Zelle geschrieben
Application.OnTime Now + TimeValue("00:00:00"), "Eintrag"
End With
' Bildschirmaktualisierung ein
Application.ScreenUpdating = True
End If
End Sub
Private Sub DropDownZoom_Change()
' Wert aus der Liste wurde gewählt
If DropDownZoom.MatchFound Then
' Umwandeln in ein Datum
'If IsDate(Range(DropDownZoom.ListFillRange).Cells(1)) Then _
DropDownZoom = CStr(CDate(DropDownZoom))
' Wert nicht in Liste vorhanden
Else
' leeren
DropDownZoom = ""
End If
' Wert aus der betreffenden Zelle des Quellbereichs in aktuelle Zelle eintragen
' ListIndex beginnt bei 0, deshalb + 1
Range(DropDownZoom.TopLeftCell.Address) = _
Range(DropDownZoom.ListFillRange).Cells(DropDownZoom.ListIndex + 1)
' aktuelle Zelle wie Ausgangszelle formatieren
Range(DropDownZoom.TopLeftCell.Address).NumberFormat = _
Range(DropDownZoom.ListFillRange).Cells(DropDownZoom.ListIndex + 1).NumberFormat
End Sub
' Makro nur zu Programmierzwecken erforderlich falls die Reaktion auf die Eingabe
' nicht mehr erfolgt
Sub bbbb()
Application.EnableEvents = True
End Sub