Para Dante Amor sobre ListBox sin duplicados en un formulario
En la anterior consulta me distes la solución para cargar un ListBox sin duplicados en un formulario. He querido repetirlo para otro caso semejante pero con mas registros y, después de intentarlo muchas veces, no lo he conseguido. Sólo me permite cargar hasta 10 items, a partir de ahí me da error 308 (no se puede se puede configurar la propiedad List). En las propiedades del ListBox1, en ColumnCount he puesto hasta 16, pero sigue el error. Como siempre muy agradecido por su atención.
Las secuencias son éstas:
Private Sub UserForm_Activate()
'Act.Por.Dante Amor
With ListBox1
For x = 2 To Range("D" & Rows.Count).End(xlUp).Row
If IsDate(Range("J" & x)) = True And _
Range("B" & x) <> "" Then
.AddItem
.List(.ListCount - 1, 0) = Range("B" & x) 'orden
.List(.ListCount - 1, 1) = Range("C" & x) 'fecha pedido
.List(.ListCount - 1, 2) = Range("D" & x) 'cliente
.List(.ListCount - 1, 3) = Range("E" & x) 'producto
.List(.ListCount - 1, 4) = Range("G" & x) 'pedido a
.List(.ListCount - 1, 5) = Range("H" & x) 'dir pedido
.List(.ListCount - 1, 6) = Range("J" & x) 'fecha factura
.List(.ListCount - 1, 7) = Range("K" & x) 'envia a
.List(.ListCount - 1, 8) = Range("L" & x) 'dir factur
.List(.ListCount - 1, 9) = Range("M" & x) 'cantidad
.List(.ListCount - 1, 10) = Range("N" & x) 'coste
.List(.ListCount - 1, 11) = Range("O" & x) 'entrega
.List(.ListCount - 1, 12) = Range("P" & x) 'pago
.List(.ListCount - 1, 13) = Range("V" & x) 'muestra
.List(.ListCount - 1, 14) = Range("Y" & x) 'notas
.List(.ListCount - 1, 15) = x
End If
Next
.ListIndex = 0
End With
End Sub
Private Sub ListBox1_Click()
If Not ListBox1.ListIndex = -1 Then
Label1.Caption = " " & ListBox1.List(ListBox1.ListIndex, 2) 'cliente
TextBox1.Text = ListBox1.List(ListBox1.ListIndex, 0) 'orden
dtpServicio.Value = ListBox1.List(ListBox1.ListIndex, 1) 'fecha pedido
ComboBox3.Text = ListBox1.List(ListBox1.ListIndex, 3) 'producto
TextBox6.Text = ListBox1.List(ListBox1.ListIndex, 4) 'envio a
TextBox4.Text = ListBox1.List(ListBox1.ListIndex, 5) 'dir pedido
DTPicker1.Value = ListBox1.List(ListBox1.ListIndex, 6) 'fecha factur
TextBox11.Text = ListBox1.List(ListBox1.ListIndex, 7) 'factura a
TextBox12.Text = ListBox1.List(ListBox1.ListIndex, 8) 'dir factura
TextBox13.Text = ListBox1.List(ListBox1.ListIndex, 9) 'cantidad
TextBox7.Text = ListBox1.List(ListBox1.ListIndex, 10) 'coste envio
ComboBox4.Text = ListBox1.List(ListBox1.ListIndex, 11) 'entrega
ComboBox5.Text = ListBox1.List(ListBox1.ListIndex, 12) 'pago
TextBox27.Text = ListBox1.List(ListBox1.ListIndex, 13) 'muestra
TextBox26.Text = ListBox1.List(ListBox1.ListIndex, 14) 'notas
1 respuesta
Efectivamente, para cargar datos en un listbox con additem sólo te permite hasta 10 columnas, digamos que es una "restricción" de VBA para cargar listbox. Lo que se hace en esos casos es utilizar la propiedad RowSource.
Crea una hoja llamada "Temp", ahora hay que pasar los datos de la "hoja1" a la hoja "Temp"
Cambia en la macro "Hoja1" por el nombre de la hoja que contiene los datos. La macro pasará de la hoja1 a la hoja "Temp" los registros que cumplan con la condición y luego cargará el listbox con la propiedad RowSource.
Private Sub UserForm_Activate()
'Act.Por.Dante Amor
Set h1 = Sheets("Hoja1")
Set h2 = Sheets("Temp")
h2.Cells.Clear
h1.Rows(1).Copy h2.Rows(1)
j = 2
'
For x = 2 To h1.Range("D" & Rows.Count).End(xlUp).Row
If IsDate(h1.Range("J" & x)) = True And h1.Range("B" & x) <> "" Then
h1.Rows(x).Copy h2.Rows(j)
h2.Cells(j, "P") = x
j = j + 1
End If
Next
'
ListBox1.ColumnCount = 16
ListBox1.ColumnHeads = True
ListBox1.RowSource = h2.Name & "!A2:P" & h2.Range("D" & Rows.Count).End(xlUp).Row
End Sub
Muchísimas Gracias Dante Amor !
Sólo una pregunta más. No se puede prescindir de la hoja Temp?
Un cordial saludo y Feliz 2015 !
Puedes copiar en la misma hoja, pero se empieza a complicar.
También puedes ocultar la hoja Temp y funciona igual.
