Listbox Additem Begrenzung umgehen
04.11.2005 15:56:01
Gernot
Ich möchte aus einer Adressentabelle einen Namen suchen und die Ergebnisse in eine Listbox anzeigen lassen und dann beim anklicken sollen die Ergebnisse in die Textboxen des Userforms übertragen.
Die Adressendatenbank hat 29 Spalten, wobei nur in verschiedenen Userforms nur bestimmte Spalten genutzt werden.
Soweit klappt das vorhaben, kann aber nur 10 Spalten aus der Listbox in die Userform übertragen.
Jetzt die Frage:
Wie kann ich die Begrenzung von 10 Spalten aus der Listbox umgehen und die restlichen Spalten in die Userform übernehemn?
Ich habe hier mal den Code mit hochgeladen:
------------------------------snip
Private Sub LB1_Click()
Dim iCounter As Integer
If gbln Then Exit Sub
frmAnkauf.Controls("ak4").Text = _
LB1.List(LB1.ListIndex, 3)
frmAnkauf.Controls("ak5").Text = _
LB1.List(LB1.ListIndex, 4)
frmAnkauf.Controls("ak7").Text = _
LB1.List(LB1.ListIndex, 6)
frmAnkauf.Controls("ak8").Text = _
LB1.List(LB1.ListIndex, 7)
frmAnkauf.Controls("ak9").Text = _
LB1.List(LB1.ListIndex, 8)
frmAnkauf.Controls("ak10").Text = _
LB1.List(LB1.ListIndex, 9)
'frmAnkauf.Controls("ak11").Text = _
LB1.List(LB1.ListIndex, 10)
'frmAnkauf.Controls("ak12").Text = _
LB1.List(LB1.ListIndex, 11)
'frmAnkauf.Controls("ak13").Text = _
LB1.List(LB1.ListIndex, 12)
'frmAnkauf.Controls("ak14").Text = _
LB1.List(LB1.ListIndex, 13)
'frmAnkauf.Controls("ak15").Text = _
LB1.List(LB1.ListIndex, 14)
'frmAnkauf.Controls("ak16").Text = _
LB1.List(LB1.ListIndex, 15)
'frmAnkauf.Controls("ak29").Text = _
LB1.List(LB1.ListIndex, 28)
'frmAnkauf.Show
Unload Me
End Sub
Private Sub UserForm_Initialize()
Dim rngC As Range, strAddress As String, varSB As Variant, lngX As Long
Dim lngZ As Long
If frmAnkauf.ak6.Value = " " Then GoTo ENDE
varSB = frmAnkauf.ak6 'Hier das Suchfeld definieren
Worksheets("Adressen").Select
With [A2:AC2000]
Set rngC = .Find(varSB, LookIn:=xlValues, Lookat:=xlPart)
If Not rngC Is Nothing Then
strAddress = rngC.Address
Do
On Error GoTo ENDE
lngX = lngX + 1
lngZ = rngC.Row
With LB1
.AddItem Cells(lngZ, 1)
.List(.ListCount - 1, 1) = Cells(lngZ, 2)
.List(.ListCount - 1, 2) = Cells(lngZ, 3)
.List(.ListCount - 1, 3) = Cells(lngZ, 4)
.List(.ListCount - 1, 4) = Cells(lngZ, 5)
.List(.ListCount - 1, 5) = Cells(lngZ, 6)
.List(.ListCount - 1, 6) = Cells(lngZ, 7)
.List(.ListCount - 1, 7) = Cells(lngZ, 8)
.List(.ListCount - 1, 8) = Cells(lngZ, 9)
.List(.ListCount - 1, 9) = Cells(lngZ, 10)
'.List(.ListCount - 1, 10) = Cells(lngZ, 11)
'.List(.ListCount - 1, 11) = Cells(lngZ, 12)
'.List(.ListCount - 1, 12) = Cells(lngZ, 13)
'.List(.ListCount - 1, 13) = Cells(lngZ, 14)
'.List(.ListCount - 1, 14) = Cells(lngZ, 15)
'.List(.ListCount - 1, 15) = Cells(lngZ, 16)
'.List(.ListCount - 1, 16) = Cells(lngZ, 17)
'.List(.ListCount - 1, 17) = Cells(lngZ, 18)
'.List(.ListCount - 1, 18) = Cells(lngZ, 19)
'.List(.ListCount - 1, 19) = Cells(lngZ, 20)
'.List(.ListCount - 1, 20) = Cells(lngZ, 21)
'.List(.ListCount - 1, 21) = Cells(lngZ, 22)
'.List(.ListCount - 1, 22) = Cells(lngZ, 23)
'.List(.ListCount - 1, 23) = Cells(lngZ, 24)
'.List(.ListCount - 1, 24) = Cells(lngZ, 25)
'.List(.ListCount - 1, 25) = Cells(lngZ, 26)
'.List(.ListCount - 1, 26) = Cells(lngZ, 27)
'.List(.ListCount - 1, 27) = Cells(lngZ, 28)
'.List(.ListCount - 1, 28) = Cells(lngZ, 29)
'.List(.ListCount - 1, 29) = Cells(lngZ, 30)
End With
Set rngC = .FindNext(rngC)
Loop While Not rngC Is Nothing And rngC.Address <> strAddress
End If
End With
If lngX = 0 Then
ENDE:
MsgBox varSB & " wurde nicht gefunden! ", 64, "Kein eingetragener Kunde"
End If
frmAnkauf.ak6.SetFocus
End Sub
-----------------------snap
Wer kann mir helfen? Danke für jede Hilfe!
mfg
Gernot