Saltar al contenido
PROGRAMAR EN VBA MACROS DE EXCEL

Como pasar datos de listbox a otro listbox con doble click


.

Anteriormente se expuso como pasar datos de un listbox a otro listbox con enter, en esta oportunidad muestro como pasar datos de un listbox a otro listbox con doble click, te recomiendo otro ejemplos con listbox como buscar datos en listbox a medida que se escribe en textbox, como agregar a listbox cabecera o header, cargar datos en textbox y pasar a listbox.

Recomiendo leer un excelente libro sobre Excel que te ayudará operar las planillas u hojas de cálculo, haz click acá, si quieres aprender sobre Excel, en inglés, entonces debes hacer click here. Si lo que necesitas es aprender o profundizar sobre la programación de macros con VBA este es unos de los mejores cursos on line que he visto en internet.

  
En este caso para pasar datos de listbox a otro listbox, se usa doble click, es decir se debe posicionar en algún dato del listbox1 y hacer doble click sobre el dato y automáticamente se pasan todos los datos de la fila seleccionada del listbox1 al listbox2.

Es preciso descargar el ejemplo para una mayor comprensión, para ello desde el link del final se puede realizar, descarga es absolutamente gratuita sin registración alguna, no obstante recomiendo registrarte para recibir actualizaciones, lo cual se podrá hacer desde el lado superior derecho de la página agregando solamente el mail.

Recomiendo observar el vídeo a continuación, para una más fácil comprensión de la macro; para suscribir a nuestro canal de You Tube debes presionar en el botón rojo que está debajo, recibirá en tu correo una comunicación cuando nuevos vídeos explicativos sobre macros sean subidos, como  por ejemplo formas de seleccionar o referenciar celdasactivar macro dependiendo de celda activaordenar hojas libro excel por su nombreconectar Excel con Access y muchos ejemplos más.


if (payload.eventType == ‘subscribe’) {
// Add code to handle subscribe event.
} else if (payload.eventType == ‘unsubscribe’) {
// Add code to handle unsubscribe event.
}
if (window.console) { // for debugging only
window.console.log(‘YT event: ‘, payload);
}
}

Código que se inserta en un módulo
Sub muestra()
UserForm1.Show
End Sub

Código que se inserta en un formulario

Private Sub CommandButton1_Click()
Unload Me
End Sub

Private Sub ListBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
On Error Resume Next
If KeyAscii = 13 Then
fila = Me.ListBox1.ListIndex
Me.ListBox2.AddItem ListBox1.List(fila, 0)
Me.ListBox2.List(ListBox2.ListCount – 1, 1) = ListBox1.List(fila, 1)
ListBox2.List(ListBox2.ListCount – 1, 2) = ListBox1.List(fila, 2)
ListBox2.List(ListBox2.ListCount – 1, 3) = ListBox1.List(fila, 3)
ListBox2.List(ListBox2.ListCount – 1, 4) = ListBox1.List(fila, 4)
ListBox2.List(ListBox2.ListCount – 1, 5) = ListBox1.List(fila, 5)
ListBox2.List(ListBox2.ListCount – 1, 6) = ListBox1.List(fila, 6)
ListBox2.List(ListBox2.ListCount – 1, 7) = ListBox1.List(fila, 7)
End If
End Sub

Private Sub TextBox1_Change()
On Error Resume Next
Set b = Sheets(«Hoja2»)
uf = b.Range(«A» & Rows.Count).End(xlUp).Row
If Trim(TextBox1.Value) = «» Then
     ‘Me.ListBox1.List() = b.Range(«A2:H» & uf).Value
     Me.ListBox1.RowSource = «Hoja2!A2:H» & uf
   Exit Sub
End If
b.AutoFilterMode = False
Me.ListBox1 = Clear
Me.ListBox1.RowSource = Clear
For i = 2 To uf
   strg = b.Cells(i, 3).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)
   End If
Next i
Me.ListBox1.ColumnWidths = «20 pt;70 pt;180 pt;80 pt;60 pt;60 pt;60 pt;60pt»
End Sub
Private Sub TextBox2_Change()
On Error Resume Next
Set b = Sheets(«Hoja2»)
uf = b.Range(«A» & Rows.Count).End(xlUp).Row
If Trim(TextBox2.Value) = «» Then
     ‘Me.ListBox1.List() = b.Range(«A2:H» & uf).Value
     Me.ListBox1.RowSource = «Hoja2!A2:H» & uf
   Exit Sub
End If
b.AutoFilterMode = False
Me.ListBox1 = Clear
Me.ListBox1.RowSource = Clear
For i = 2 To uf
   strg = b.Cells(i, 4).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)
   End If
Next i
Me.ListBox1.ColumnWidths = «20 pt;70 pt;180 pt;80 pt;60 pt;60 pt;60 pt;60pt»
End Sub

Private Sub UserForm_Initialize()
Dim fila As Long
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set b = Sheets(«Hoja2»)
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 = 8
    .ColumnWidths = «20 pt;70 pt;180 pt;80 pt;60 pt;60 pt;60 pt;60pt»
    .RowSource = «Hoja2!A2:» & wc & uf
End With
With Me.ListBox2
    .ColumnCount = 8
    .ColumnWidths = «20 pt;70 pt;180 pt;80 pt;60 pt;60 pt;60 pt;60pt»
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
On Error GoTo Fin
If CloseMode <> 1 Then Cancel = True
Fin:
End Sub

Si te fue de utilidad puedes INVITARME UN CAFÉ y de esta manera ayudar a seguir manteniendo la página, CLICK para descargar en ejemplo en forma gratuita.


.

If this post was helpful INVITE ME A COFFEE and so help keep up the page, CLICK to download free example.

Si te gustó por favor compártelo con tus amigos
If you liked please share it with your friends