Tengo un Listbox con 20 columnas pero sólo me muestra 10
Tengo un listbox con 20 columnas pero sólo me muestra 10. El código es el siguiente:
Private Sub CommandButton1_Click()
Unload Me
End Sub
Private Sub Label2_Click()
End Sub
Private Sub Label3_Click()
End Sub
Private Sub ListBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
On Error Resume Next
If KeyAscii = 13 Then
Set a = Sheets("Hoja1")
filaedit = a.Range("A" & Rows.Count).End(xlUp).Row + 1
fila = Me.ListBox1.ListIndex
a.Cells(filaedit, "A") = ListBox1.List(fila, 0)
a.Cells(filaedit, "B") = ListBox1.List(fila, 1)
a.Cells(filaedit, "C") = ListBox1.List(fila, 2)
a.Cells(filaedit, "D") = ListBox1.List(fila, 3)
a.Cells(filaedit, "E") = ListBox1.List(fila, 4)
a.Cells(filaedit, "F") = ListBox1.List(fila, 5)
a.Cells(filaedit, "G") = ListBox1.List(fila, 6)
a.Cells(filaedit, "H") = ListBox1.List(fila, 7)
a.Cells(filaedit, "I") = ListBox1.List(fila, 8)
a.Cells(filaedit, "J") = ListBox1.List(fila, 9)
a.Cells(filaedit, "K") = ListBox1.List(fila, 10)
a.Cells(filaedit, "L") = ListBox1.List(fila, 11)
a.Cells(filaedit, "M") = ListBox1.List(fila, 12)
a.Cells(filaedit, "N") = ListBox1.List(fila, 13)
a.Cells(filaedit, "O") = ListBox1.List(fila, 14)
a.Cells(filaedit, "P") = ListBox1.List(fila, 15)
a.Cells(filaedit, "Q") = ListBox1.List(fila, 16)
a.Cells(filaedit, "R") = ListBox1.List(fila, 17)
a.Cells(filaedit, "S") = ListBox1.List(fila, 18)
a.Cells(filaedit, "T") = ListBox1.List(fila, 19)
End If
End Sub
Private Sub TextBox1_Change()
On Error Resume Next
Set b = Sheets("Tercero_A")
uf = b.Range("A" & Rows.Count).End(xlUp).Row
If Trim(TextBox1.Value) = "" Then
'Me.ListBox1.List() = b.Range("A8:T" & uf).Value
Me.ListBox1.RowSource = "Tercero_A!A8:T" & uf
Exit Sub
End If
b.AutoFilterMode = False
Me.ListBox1 = Clear
Me.ListBox1.RowSource = Clear
For i = 2 To uf
strg = b.Cells(i, 2).Value
If UCase(strg) Like UCase(TextBox1.Value) & "*" Then
Me.ListBox1.AddItem b.Cells(i, 1)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = b.Cells(i, 2)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = b.Cells(i, 3)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = b.Cells(i, 4)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 4) = b.Cells(i, 5)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 5) = b.Cells(i, 6)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 6) = b.Cells(i, 7)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 7) = b.Cells(i, 8)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 8) = b.Cells(i, 9)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 9) = b.Cells(i, 10)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 10) = b.Cells(i, 11)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 11) = b.Cells(i, 12)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 12) = b.Cells(i, 13)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 13) = b.Cells(i, 14)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 14) = b.Cells(i, 15)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 15) = b.Cells(i, 16)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 16) = b.Cells(i, 17)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 17) = b.Cells(i, 18)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 18) = b.Cells(i, 19)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 19) = b.Cells(i, 20)
End If
Next i
Me.ListBox1.ColumnWidths = "25pt; 150pt; 0pt; 0pt; 0pt; 0pt; 50pt; 50pt; 50pt; 50pt; 0pt; 50pt; 50pt; 50pt; 0pt; 0pt; 0pt; 0pt; 0pt; 50pt"
End Sub
Private Sub TextBox2_Change()
On Error Resume Next
Set b = Sheets("Tercero_A")
uf = b.Range("A" & Rows.Count).End(xlUp).Row
If Trim(TextBox2.Value) = "" Then
'Me.ListBox1.List() = b.Range("A8:T" & uf).Value
Me.ListBox1.RowSource = "Tercero_A!A8:T" & uf
Exit Sub
End If
b.AutoFilterMode = False
Me.ListBox1 = Clear
Me.ListBox1.RowSource = Clear
For i = 2 To uf
strg = b.Cells(i, 1).Value
If UCase(strg) Like UCase(TextBox2.Value) & "*" Then
Me.ListBox1.AddItem b.Cells(i, 1)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = b.Cells(i, 2)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = b.Cells(i, 3)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = b.Cells(i, 4)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 4) = b.Cells(i, 5)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 5) = b.Cells(i, 6)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 6) = b.Cells(i, 7)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 7) = b.Cells(i, 8)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 8) = b.Cells(i, 9)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 9) = b.Cells(i, 10)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 10) = b.Cells(i, 11)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 11) = b.Cells(i, 12)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 12) = b.Cells(i, 13)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 13) = b.Cells(i, 14)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 14) = b.Cells(i, 15)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 15) = b.Cells(i, 16)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 16) = b.Cells(i, 17)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 17) = b.Cells(i, 18)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 18) = b.Cells(i, 19)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 19) = b.Cells(i, 20)
End If
Next i
Me.ListBox1.ColumnWidths = "25pt; 150pt; 0pt; 0pt; 0pt; 0pt; 50pt; 50pt; 50pt; 50pt; 0pt; 50pt; 50pt; 50pt; 0pt; 0pt; 0pt; 0pt; 0pt; 50pt"
End Sub
Private Sub UserForm_Initialize()
Dim fila As Long
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set b = Sheets("Tercero_A")
uf = b.Range("A" & Rows.Count).End(xlUp).Row
uc = b.Cells(1, Columns.Count).End(xlToLeft).Address
wc = Mid(uc, InStr(uc, "$") + 1, InStr(2, uc, "$") - 2)
With Me.ListBox1
.ColumnCount = 20
.ColumnWidths = "25pt; 150pt; 0pt; 0pt; 0pt; 0pt; 50pt; 50pt; 50pt; 50pt; 0pt; 50pt; 50pt; 50pt; 0pt; 0pt; 0pt; 0pt; 0pt; 50pt"
.RowSource = "Tercero_A!A8:" & wc & uf
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
PREGUNTA: ¿Cuál será el error?
Anticipadamente.
2 Respuestas
Revisa el siguiente enlace:
Codigo VBA para un Listbox con mas de 10 columnas
En VBA con el método Adiitem solamente puedes cargar 10 columnas.
No te envía error VBA porque tienes la sentencia On Error Resume Next; pero si quitas la sentencia y ejecutas el userform para cargar los datos verás que se detiene cuando quieres agregar la columna 11.
sal u dos
El problema es que no sé nada de programación :-(
¿Podrían ayudarme a generar el código? No existe ningún problema cuando carga la base datos, carga perfectamente las 20 columnas, el problema se presenta cuando al filtrar sólo me aparecen hasta 10 columnas cuando necesito que también en el filtrado carguen las 20 columnas.
Disculpen las molestias. Anticipadamente, gracias.
No es ninguna molestia.
Tu código tiene algunos detalles.
- El rowsource lo cargas desde la fila 8, pero los For empiezan en la fila 2.
Voy a suponer que tus datos empiezan en la fila 2 y que el encabezado está en la fila 1.
- Solamente muestra 10 columnas, primero, porque con Additem solamente puedes cargar 10 columnas; y segundo, tienes en columnwidth 10 columnas en 0pt
Realiza las siguientes instrucciones.
1. Crea una hoja llamada "temp"
2. Cambia todo tu código por el siguiente:
Dim h1, h2, h3
'
Private Sub TextBox1_Change()
Call Filtrar("B", TextBox1.Value)
End Sub
Private Sub TextBox2_Change()
Call Filtrar("A", TextBox2.Value)
End Sub
'
Sub Filtrar(col, dato)
'Por.Dante Amor
h2.Cells.Clear
h1.Rows(1).Copy h2.Rows(1)
f = 2
j = 2
ListBox1.RowSource = ""
uf = h1.Range("A" & Rows.Count).End(xlUp).Row
h1.AutoFilterMode = False
For i = f To uf
If UCase(h1.Cells(i, col).Value) Like UCase(dato) & "*" Then
h1.Rows(i).Copy h2.Rows(j)
h2.Cells(j, "U") = i
j = j + 1
End If
Next i
uf = h2.Range("A" & Rows.Count).End(xlUp).Row
If uf > 1 Then ListBox1.RowSource = h2.Name & "!A2:U" & uf
End Sub
'
Private Sub ListBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
'Act.Por.Dante Amor
If KeyAscii <> 13 Then Exit Sub
'
u = h3.Range("A" & Rows.Count).End(xlUp).Row + 1
fila = ListBox1.List(ListBox1.ListIndex, 20)
h1.Rows(fila).Copy h3.Rows(u)
MsgBox "Registro copiado de " & h1.Name & " a " & h3.Name, vbInformation
End Sub
'
Private Sub UserForm_Initialize()
'Act.Por.Dante Amor
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set h1 = Sheets("Tercero_A")
Set h2 = Sheets("Temp")
Set h3 = Sheets("Hoja1")
uf = h1.Range("A" & Rows.Count).End(xlUp).Row
With Me.ListBox1
.ColumnCount = 20
.ColumnHeads = True
End With
TextBox1_Change
End Sub
'
Private Sub CommandButton1_Click()
Unload Me
End Sub3. En mi macro f = 2 , cambia el 2 por el número de fila donde empiezan tus datos.
4. Revisa que al principio de todo el código queden las declaraciones de variables:
Dim h1, h2
Sal u dos
Muchas gracias Dante, he probado la macro y me muestra las 20 columnas que anteriormente no lo hacia, además de mencionarte que los encabezados ahora hasta me los muestra, cosa que anteriormente uno los tenía que escribir de manera manual. Te agradezco infinitamente todo tu apoyo y dedicación de tiempo a mis dudas y necesidades. Recibe un abrazo. ¡Saludos!
A lo dicho puedes cargar más de 10 columnas si usas el método rowsource, te paso un ejemplo
https://youtu.be/4YyMHEZ1h_8
Ya revisé el video maestro y entiendo que el Rowsoucer carga las 20 columnas en la base de datos, mi problema se presenta cuando al hacer el filtrado sólo me aparece la información de 20 columnas y el resto de la información desaparece. No se nada de programación, de hecho, el código lo obtuve revisando sus tutoriales maestro. ¿Sería mucho pedir que me generara el código para posteriormente pegarlo en mi archivo? Anticipadamente, gracias.
Sube tu archivo desde http://programarexcel.com o mail que esta ahí.