ComboBox mehrere Zellen über Auswahl füllen
17.02.2005 11:36:42
Frank
ich bin schon viele Stunden am probieren und suchen im Netz habe bisher aber noch keine Lösung für mein Problem gefunden.
Ich möchte über die Auswahl in einer Combobox mehrere Felder in meinem Formular bestücken und anschließend mit "OK" immer in die gleichen Zellen einer Arbeitsmappe schreiben!
Leider wird nur der gewählte Wert in die Arbeitsmappe übertragen.
Mir ist nicht klar, welche Definitionen gemacht werden müssen um die anderen Werte, die alle Zeilenweise erfaßt sind (a1-a10; b1-b10;...) eingelesen werden können. In der Combobox werden sie jedoch angezeigt!
Sub UserForm_Initialize()
Dim a As Integer, z As Integer
Dim distanz As Integer, i As Integer
Dim feld1 As Variant, feld2 As Variant
Dim System As Variant
a = 1
z = 20 ' Max Anzahl Namen in der ADMlistenübersicht
distanz = 1 ' Anzahl Spalten in der Listbox bis angezeigte Spalte erscheint
cboAdm.ColumnCount = 3 ' Tabellenbereich in die Liste übernehmen
For i = a To z ' Datenquelle festlegen
feld1 = worksheets("adm+TECHNIK").Cells(i + distanz, 1)
feld2 = worksheets("adm+TECHNIK").Cells(i + distanz, 2)
With cboAdm
.AddItem '
.List(i - 1, 1) = feld1 'Spalte 1=Nr.
.List(i - 1, 2) = feld2 'Spalte 2=Name
End With
Next i
With cboAdm 'Auswahl der ADM
.Style = fmStyleDropDownList ' Das Kombifeld verhält sich wie ein Listenfeld
.ListIndex = 0 ' Anfangselement der Auswahlliste bestimmen
.ListWidth = "4 cm" ' Listenbreite
.ColumnWidths = "0,0 cm; 0,5 cm; 2 cm " ' Spaltenbreite
.TextColumn = 3 ' an Kombifeld (Dropdownmenü)zu liefernde Spalte
.BoundColumn = 3 ' Wahl der Spaltennummer für die Wertentnahme/-übergabe in Textfeld txt.Material
End With
End Sub
Private Sub cboADM_Change()
txtAdmAnsicht.Value = cboAdm.Value
End Sub
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub cmdOK_Click()
worksheets("Angebotsschreiben").Activate
[E8] = txtAdmAnsicht.Value 'Rückgabe ADM in Tabellenblatt "Positionsübersicht"
[E10] = txtStraße.Value 'Rückgabe Straße
[E12] = txtOrt.Value 'Rückgabe Straße
[F14] = txtTelefon.Value 'Rückgabe Telefon
[F16] = txtFax.Value 'Rückgabe Fax
[F18] = txtMail.Value 'Rückgabe Mailadresse
Unload Me
End Sub
Vielleicht hat jemand einen gute Idee, wie man das Problem lösen kann.
Vielen Dank im voraus.
Frank