Como cargar datos en textbox y pasar a listbox





En esta oportunidad a pedido de un suscriptor de nuestro canal You Tube, se presenta esta macro que permite cargar datos en textbox luego pasarlos a un listbox y sumar importes de listbox, anteriormente se han presentado un gran número de ejemplos que trabajan con listbox que quizás también sean de utilidad:pasar datos de listbox a hoja de Excel, pasar datos de listbox a hoja de Excel con enter, buscar en listbox mientras se escribe en textbox, entre otros.

Antes de seguir 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.


  

El formulario es un poco complejo, por lo que se recomienda descargar el archivo y ver el tutorial para una mejor y más fácil comprensión, en primer lugar se podrá ver en el archivo un botón que permite ejecutar la macro que muestra un formulario donde se vislumbran, textbox, combobox y un listbox.

En el formulario se encuentran una serie de controles para evitar que se ingresen datos erroneos, una vez llenados los textbox, con el botón guardar se pasan los datos al listbox que se encuentra a la derecha del formulario.

Se observa que a medida que se vallan ingresando datos, los importes de cada registros que se encuentran en el listbox se va sumando e mostrando el resultado en el textbox que se encuentra al final del formulario.

Si se requiere editar un dato del listbox, solo se debe hacer doble click en el registro correspondiente en el listbox, pasándose los datos a los textbox para su modificación, a su vez se resta del textbox que muestra el total de importe cargado en el listbox

Presionando el botón enviar, se envían los datos del listbox,  desde la Hoja 1  a Hoja 6, de pendiendo del número de caja que se haya cargado.

El vídeo que sigue muestra una explicación más detallada y gráfica de la macro presentada, recomiendo observar para una más fácil comprensión de la macro; suscribe a nuestra web desde la parte superior derecha de la página ingresando tu mail y a nuestro canal de You Tube para recibir en tu correo vídeos explicativos sobre macros interesantes, como  por ejemplo formulario que crea un listado de todas las hojas para poder luego seleccionarlasbuscar en listbox mientras escribes en textboxordenar hojas libro excel por su nombreconectar Excel con Access y muchos ejemplos más.








Código que se inserta en un módulo




Sub muestra()
CargaCupones.Show
End Sub

Código que se inserta en un formulario

Private Sub ComboBox2_Change()
'Verifica que se haya ingresado bien la fecha antes de desactivar el textbox de fecha
'Valida fecha para el text box
Dim ubica1, ubica2 As String
Dim dia, mes As Integer
Dim año, fecha As Integer
'guardamos en variables el caracter encontrado en la posición 3 y 6
ubica1 = Mid(TextBoxFechaCupon.Text, 3, 1)
ubica2 = Mid(TextBoxFechaCupon.Text, 6, 1)
'comparamos si se trata de '/'
'antes de verificar se fija si el text box es vacio porque de lo contrario salta el dialogo

If TextBox4 <> Empty Then

If ubica1 <> "/" Or ubica2 <> "/" Then

MsgBox ("Debes ingresar datos con este formato: dd/mm/aa"), vbCritical
TextBoxFechaCupon.SetFocus
Exit Sub
End If

dia = Mid(TextBoxFechaCupon.Value, 1, 2)
mes = Mid(TextBoxFechaCupon.Value, 4, 2)
año = Mid(TextBoxFechaCupon.Value, 7, 4)
fecha = Len(TextBoxFechaCupon)

'Controla lo ingresado, si no se cumple no es fecha y sale en msgbox
If dia > 31 Or mes > 12 Or año < 1900 Or fecha > 10 Then
MsgBox "Fecha incorrecta", vbCritical
TextBoxFechaCupon.SetFocus
Exit Sub
End If

End If

If ComboBox2 <> Empty Then
ComboBox2.Enabled = False
TextBoxFechaCupon.Enabled = False
End If
End Sub

Private Sub ComboBox3_Change()
Dim filacargacupon As Integer
Dim fila As Integer
Dim dato As Date
On Error Resume Next

'Dependiendo del valor del combobox va a ser la hoja activa en la que se copiaran los datos
If ComboBox3 <> "" Then
Select Case ComboBox3
Case Is = "1"
hojaactiva = "Caja1"
Case Is = "2"
hojaactiva = "Caja2"
Case Is = "3"
hojaactiva = "Caja3"
Case Is = "4"
hojaactiva = "Caja4"
Case Is = "5"
hojaactiva = "Caja5"
Case Is = "6"
hojaactiva = "Caja6"
End Select
End If

ListBox1.Clear

'Adiciona un item al listbox reservado para la cabecera
ListBox1.AddItem

filacargacupon = 2
fechabusqueda = CDate(TextBox5.Value)
fila = 1

 While Sheets(hojaactiva).Cells(filacargacupon, 1) <> Empty
        dato = Sheets(hojaactiva).Cells(filacargacupon, 1)
  'For fila = 0 To ListBox1.ListCount - 1
 ListBox1.AddItem Sheets(hojaactiva).Cells(filacargacupon, 1)
 ListBox1.List(fila, 1) = Sheets(hojaactiva).Cells(filacargacupon, 2)
 ListBox1.List(fila, 2) = Sheets(hojaactiva).Cells(filacargacupon, 3)
 ListBox1.List(fila, 3) = Sheets(hojaactiva).Cells(filacargacupon, 4)
 ListBox1.List(fila, 4) = Sheets(hojaactiva).Cells(filacargacupon, 5)
 ListBox1.List(fila, 5) = Sheets(hojaactiva).Cells(filacargacupon, 6)
 ListBox1.List(fila, 6) = Sheets(hojaactiva).Cells(filacargacupon, 7)
 'Next
 fila = fila + 1
 filacargacupon = filacargacupon + 1
Wend
'Carga los datos de la cabecera en listbox
For ii = 0 To 6
ListBox1.List(0, ii) = Sheets(hojaactiva).Cells(1, ii + 1)
Next ii
End Sub

Private Sub CommandButton1_Click()
On Error Resume Next
Application.ScreenUpdating = False
'Valida fecha para el text box
Dim ubica1, ubica2 As String
Dim dia, mes As Integer
Dim año, fecha As Integer
Dim IndiceLis As Integer
Dim VTotal As Double
'guardamos en variables el caracter encontrado en la posición 3 y 6
ubica1 = Mid(TextBoxFechaCupon.Text, 3, 1)
ubica2 = Mid(TextBoxFechaCupon.Text, 6, 1)
'comparamos si se trata de '/'
If ubica1 <> "/" Or ubica2 <> "/" Then
MsgBox ("Debes ingresar datos con este formato: dd/mm/aa")
TextBoxFechaCupon.SetFocus
Exit Sub
End If
dia = Mid(TextBoxFechaCupon.Value, 1, 2)
mes = Mid(TextBoxFechaCupon.Value, 4, 2)
año = Mid(TextBoxFechaCupon.Value, 7, 4)
fecha = Len(TextBoxFechaCupon)

'Controla lo ingresado, si no se cumple no es fecha y sale en msgbox
If dia > 31 Or mes > 12 Or año < 1900 Or fecha > 10 Then
MsgBox "Fecha incorrecta"
TextBoxFechaCupon.SetFocus
Exit Sub
End If

If ComboBox4 = Empty Then
MsgBox "Debe ingresar número de terminal", vbCritical
ComboBox4.SetFocus
ComboBox4.SelLength = Len(ComboBox4.Text)
Exit Sub
End If



If Not IsNumeric(TextBox2.Value) Then
MsgBox "Debe ingresar un número de lote", vbCritical
TextBox2.SetFocus
TextBox2.SelLength = Len(TextBox2.Text)
Exit Sub
End If

If ComboBox1 = Empty Then
MsgBox "Debe ingresar nombre de tarjeta"
ComboBox1.SetFocus
ComboBox1.SelLength = Len(ComboBox1.Text)
Exit Sub
End If

If Not IsNumeric(TextBox3.Value) Then
MsgBox "Debe ingresar un número de cupón", vbCritical
TextBox3.SetFocus
TextBox3.SelLength = Len(TextBox3.Text)
Exit Sub
End If


'Verifica que no se ingresen comas en el importe
'primero convertimos a mayúsculas para realizar la comparación
Dim texto1 As String
texto1 = UCase(TextBox3.Value)
If InStr(texto1, ",") > 0 Then
'instrucciones si el texto fue encontrado
MsgBox "Debe ingresar sólo números", vbInformation
TextBox3.SetFocus
Exit Sub
End If


'Verifica que no se ingresen puntos en el importe
texto1 = UCase(TextBox3.Value)
If InStr(texto1, ".") > 0 Then
'instrucciones si el texto fue encontrado
MsgBox "Debe ingresar sólo números", vbInformation
TextBox3.SetFocus
Exit Sub
End If


If Not IsNumeric(TextBox4.Value) Then
MsgBox "Debe ingresar un importe de cupón", vbCritical
TextBox4.SetFocus
TextBox4.SelLength = Len(TextBox4.Text)
Exit Sub
End If


'Verifica que no se ingresen comas en el importe
texto1 = UCase(TextBox4.Value)
If InStr(texto1, ",") > 0 Then
'instrucciones si el texto fue encontrado
MsgBox "Debe ingresar importe en este formato ###.##", vbCritical
TextBox4.SetFocus
Exit Sub
End If


'Determina que no se ingresen más de dos decimales
texto2 = UCase(TextBox4.Value)

'Si existe "," instr dará el lugar y será mayor a cero
If InStr(texto2, ".") > 0 Then
'Se obtiene donde esta ubicado el punto y desde ahí inclusive cuenta tres lugares
cantcarat = InStr(texto2, ".")
lugaresdecimales = Len(Mid(texto2, cantcarat, 4))
If lugaresdecimales > 3 Then
MsgBox "Debe ingresar como máximo dos decimales", vbCritical
TextBox4.SetFocus
Exit Sub
End If
End If



If ComboBox2 = Empty Then
MsgBox "Debe ingresar número de caja"
ComboBox2.SetFocus
ComboBox2.SelLength = Len(ComboBox2.Text)
Exit Sub

End If


'Antes de copiar en los datos en el listbox verifica que no se carguen datos duplicados
Dim a As Long
Dim dato1, dato2, dato3, dato4, dato5 As String
a = 0
While a <= ListBox2.ListCount

dato1 = ListBox2.List(a, 0)
dato2 = ListBox2.List(a, 1)
dato3 = ListBox2.List(a, 2)
dato4 = ListBox2.List(a, 3)
dato5 = ListBox2.List(a, 4)

     If dato1 = TextBoxFechaCupon And _
        dato2 = ComboBox4 And _
        dato3 = TextBox2.Value And _
        dato4 = ComboBox1 And _
        dato5 = TextBox3.Value Then
        MsgBox "El cupon ya fue cargado", vbCritical
        TextBox3.SetFocus
        TextBox3.SelLength = Len(TextBox3.Text)
     Exit Sub
     End If
a = a + 1
Wend



'Copia los textbox al list box

a = ListBox2.ListCount
ListBox2.AddItem TextBoxFechaCupon
ListBox2.List(a, 1) = ComboBox4
ListBox2.List(a, 2) = TextBox2
ListBox2.List(a, 3) = ComboBox1
ListBox2.List(a, 4) = TextBox3
ListBox2.List(a, 5) = Val(TextBox4.Value)
ListBox2.List(a, 6) = ComboBox2


'Suma el importe del listbox
For IndiceLis = 0 To ListBox2.ListCount - 1
VTotal = VTotal + CDbl(ListBox2.List(IndiceLis, 5))
Next IndiceLis
TextBox6 = VTotal


'limpia ciertos textbox
TextBox4 = Clear
TextBox3 = Clear
TextBox3.SetFocus


End Sub
Sub otra()
Application.ScreenUpdating = False

'Evita que se carge duplicados en la base de datos

Dim Quebusco0 As String
Dim Quebusco1 As String
Dim Quebusco2 As String
Dim Quebusco3 As String
'Dim Quebusco4 As String
'Dim Quebusco5 As String
'Dim Quebusco6 As String
'Dim filabusqueda As String
filabusqueda = 2

'la variable Que guarda el dato ingresado

Quebusco0 = TextBoxFechaCupon.Value
Quebusco1 = TextBox2.Value
Quebusco2 = ComboBox1.Value
Quebusco3 = TextBox3.Value
'Quebusco4 = TextPrefijo.Value
'Quebusco5 = TextNumero.Value
'Quebusco6 = "Anulada"

'Dependiendo del valor del combobox va a ser la hoja activa en la que se copiaran los datos
If ComboBox2 <> "" Then
Select Case ComboBox2
Case Is = "1"
hojaactiva = "Caja1"
Case Is = "2"
hojaactiva = "Caja2"
Case Is = "3"
hojaactiva = "Caja3"
Case Is = "4"
hojaactiva = "Caja4"
Case Is = "5"
hojaactiva = "Caja5"
Case Is = "6"
hojaactiva = "Caja6"
End Select
End If


' busca en la hoja dbcomp los datos de los combo y texbox para determinar si hay duplicados
While Sheets(hojaactiva).Cells(filabusqueda, 2) <> Empty

    If Quebusco0 = Sheets(hojaactiva).Cells(filabusqueda, 1).Value And _
        Quebusco1 = Sheets(hojaactiva).Cells(filabusqueda, 2).Value And _
        Quebusco2 = Sheets(hojaactiva).Cells(filabusqueda, 3).Value And _
        Quebusco3 = Sheets(hojaactiva).Cells(filabusqueda, 4).Value Then
    
    
    'si se encuentra el dato puede mostrar un mensaje de error como el siguiente

    MsgBox "Dato duplicado", vbCritical
    
    'se posiciona en combobox fecha
    TextBox3.SetFocus
    Exit Sub
    Else
    filabusqueda = filabusqueda + 1
    End If
Wend


'Copia los datos en la hoja de la caja correspondiente
Sheets(hojaactiva).Select
filalibre = ActiveSheet.Range("c65536").End(xlUp).Row + 1
Cells(filalibre, 1) = CDate(TextBoxFechaCupon)
Cells(filalibre, 2) = TextBox2.Value
Cells(filalibre, 3) = ComboBox1.Value
Cells(filalibre, 4) = TextBox3.Value
Cells(filalibre, 5) = TextBox4.Value
Cells(filalibre, 6) = ComboBox2.Value

'limpia ciertos textbox
TextBox4 = Clear
TextBox3 = Clear
TextBox3.SetFocus
Application.ScreenUpdating = True
End Sub

Private Sub CommandButton10_Click()
If ListBox2.List(fila, 0) <> Empty Then
MsgBox "Debe enviar los datos a la planilla primero", vbCritical
Exit Sub
End If
TextBoxFechaCupon = Clear
TextBoxFechaCupon.Enabled = True
TextBox2 = Clear
TextBox3 = Clear
TextBox4 = Clear
TextBox8 = Clear
ComboBox1 = Clear
ComboBox2 = Clear
ComboBox2.Enabled = True
ComboBox4 = Clear



End Sub

Private Sub CommandButton11_Click()
TextBoxFechaCupon.Enabled = True
End Sub

Private Sub CommandButton2_Click()

If ListBox2.List(fila, 0) <> Empty Then
   respuesta = MsgBox("Existen datos que no se han guardado" & Chr(10) & "¿Desea salir de todos modos?" & Chr(10) & _
  "Perderá los datos no guardados", vbInformation + vbYesNo)

   If respuesta = 6 Then
     Unload Me
   End If
Else
Unload Me
End If
End Sub

Private Sub CommandButton3_Click()
'UserForm1.ListBox1.RowSource = Sheets("caja1").Range("A1:f65536").Address
End Sub

Private Sub CommandButton9_Click()
Application.ScreenUpdating = False
'Verifica que la fecha no este vacia
If TextBoxFechaCupon = Empty Then
MsgBox "No se han ingresado datos", vbCritical
Exit Sub
End If

Dim filapos As String
conta = 0
filapos = 2


'Dependiendo del valor del ListBox va a ser la hoja activa en la que se copiaran los datos
a = 0
If ListBox2.List(a, 6) <> Empty Then
Select Case ListBox2.List(a, 6)
Case Is = "1"
hojaactiva = "Caja1"
Case Is = "2"
hojaactiva = "Caja2"
Case Is = "3"
hojaactiva = "Caja3"
Case Is = "4"
hojaactiva = "Caja4"
Case Is = "5"
hojaactiva = "Caja5"
Case Is = "6"
hojaactiva = "Caja6"
End Select
End If


'En el caso que se sobreescriba celdas con datos, antes de guardar los datos previamente
'ultimos datos
Dim filabusqueda As String
Dim dato1 As Date
Dim dato2 As String
filabusqueda = 2
If respuesta = 6 Then

While Sheets(hojaactiva).Cells(filabusqueda, 1) <> Empty
   dato1 = Sheets(hojaactiva).Cells(filabusqueda, 1)
   dato2 = Sheets(hojaactiva).Cells(filabusqueda, 7)
    If dato1 = dato And _
       dato2 = ComboBox2 Then
       Sheets(hojaactiva).Cells(filabusqueda, 1).Select
       ActiveCell.EntireRow.Delete
    Else
    filabusqueda = filabusqueda + 1
    End If
Wend
End If

Dim filacargacupon As Integer
Dim fila As Integer
filacargacupon = Sheets(hojaactiva).Range("a65536").End(xlUp).Row + 1
For fila = 0 To ListBox2.ListCount - 1
 Sheets(hojaactiva).Cells(filacargacupon, 1) = CDate(ListBox2.List(fila, 0))
 Sheets(hojaactiva).Cells(filacargacupon, 2) = ListBox2.List(fila, 1)
 Sheets(hojaactiva).Cells(filacargacupon, 3) = ListBox2.List(fila, 2)
 Sheets(hojaactiva).Cells(filacargacupon, 4) = ListBox2.List(fila, 3)
 Sheets(hojaactiva).Cells(filacargacupon, 5) = ListBox2.List(fila, 4)
 Sheets(hojaactiva).Cells(filacargacupon, 6) = CDec(ListBox2.List(fila, 5))
 Sheets(hojaactiva).Cells(filacargacupon, 7) = ListBox2.List(fila, 6)
 filacargacupon = filacargacupon + 1
Next

'Limpia objetos del form
TextBoxFechaCupon = Clear
TextBoxFechaCupon.Enabled = True
TextBox2 = Clear
TextBox3 = Clear
TextBox4 = Clear
ComboBox4 = Clear
ComboBox1 = Clear
ComboBox2 = Clear
ComboBox2.Enabled = True
'limpia los text box
For fila = 0 To ListBox2.ListCount - 1
ListBox2.List(fila, 0) = Clear
ListBox2.List(fila, 1) = Clear
ListBox2.List(fila, 2) = Clear
ListBox2.List(fila, 3) = Clear
ListBox2.List(fila, 4) = Clear
ListBox2.List(fila, 5) = Clear
ListBox2.List(fila, 6) = Clear
Next

Unload Me
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Private Sub ListBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
On Error Resume Next
respuesta = MsgBox("¿Seguro desea modificar el dato seleccionado?", vbInformation + vbYesNo)

If respuesta = 6 Then
fila = ListBox2.ListIndex

ComboBox4 = ListBox2.List(fila, 1)
TextBox2 = ListBox2.List(fila, 2)
ComboBox1 = ListBox2.List(fila, 3)
TextBox3 = ListBox2.List(fila, 4)
TextBox4 = ListBox2.List(fila, 5)
ComboBox2 = ListBox2.List(fila, 6)
ListBox2.RemoveItem ListBox2.ListIndex

'Suma los valores del listbox después de eliminar filas del listbox
Dim IndiceLis As Integer
Dim VTotal As Double

For IndiceLis = 0 To ListBox2.ListCount - 1
VTotal = VTotal + CDbl(ListBox2.List(IndiceLis, 5))
Next IndiceLis
TextBox6 = VTotal

End If
End Sub

Private Sub TextBox5_Change()
ComboBox3 = Clear
ListBox1 = Clear
End Sub


Private Sub TextBoxFechaCupon_AfterUpdate()
On Error Resume Next
'Verifica que se haya ingresado bien la fecha
'Valida fecha para el text box
Dim ubica1, ubica2 As String
Dim dia, mes As Integer
Dim año, fecha As Integer
'guardamos en variables el caracter encontrado en la posición 3 y 6

ubica1 = Mid(TextBoxFechaCupon.Text, 3, 1)

ubica2 = Mid(TextBoxFechaCupon.Text, 6, 1)

'comparamos si se trata de '/'
'Controlo solo en el caso de tener datos el text box, sino da error cuando se envian datos
If textboxfehcacupon <> Empty Then

If ubica1 <> "/" Or ubica2 <> "/" Then
MsgBox ("Debes ingresar datos con este formato: dd/mm/aa"), vbCritical
TextBoxFechaCupon.SetFocus
TextBoxFechaCupon.SelLength = Len(TextBoxFechaCupon.Text)
Exit Sub
End If

dia = Mid(TextBoxFechaCupon.Value, 1, 2)
mes = Mid(TextBoxFechaCupon.Value, 4, 2)
año = Mid(TextBoxFechaCupon.Value, 7, 4)
fecha = Len(TextBoxFechaCupon)

'Controla lo ingresado, si no se cumple no es fecha y sale en msgbox
If dia > 31 Or mes > 12 Or año < 1900 Or fecha > 10 Then
MsgBox "Fecha incorrecta"
TextBoxFechaCupon.SetFocus
Exit Sub
End If

End If

dato = CDate(TextBoxFechaCupon)
filapos = 2
While filapos <> 1086 And conta = 0
    If Sheets("POS").Cells(filapos, 14) = dato Then
         ' Una vez encontrada la fila con la fecha igual al text box y se fija 3 celdas hacia arriba
         ' estableciendo si esta oculta o no en su caso no copia los datos por estar ya hecha la caja
         If Rows(filapos).Hidden = True Then
            MsgBox "La caja del día seleccionado ya fue realizada", vbCritical
            TextBoxFechaCupon = Clear
            TextBoxFechaCupon.SetFocus
            Exit Sub
         End If
        
       conta = 1
    End If

filapos = filapos + 1
Wend
If conta = 0 Then
MsgBox "La fecha ingresada no se encuentra", vbInformation
TextBoxFechaCupon = Clear
TextBoxFechaCupon.SetFocus
Exit Sub
End If
End Sub

Private Sub UserForm_Initialize()
MultiPage1.Value = 0
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
'Carga datos en los combobox
'Carga datos de tarjeta
Dim fila As String
fila = 2
While Sheets("Parametros").Cells(fila, 1) <> Empty
ComboBox1.AddItem Sheets("Parametros").Cells(fila, 1)
fila = fila + 1
Wend
'Carga datos de caja
fila = 2
While Sheets("Parametros").Cells(fila, 2) <> Empty
ComboBox2.AddItem Sheets("Parametros").Cells(fila, 2)
ComboBox3.AddItem Sheets("Parametros").Cells(fila, 2)
fila = fila + 1
Wend
'carga número de terminal
fila = 2
While Sheets("Parametros").Cells(fila, 3) <> Empty
ComboBox4.AddItem Sheets("Parametros").Cells(fila, 3)
fila = fila + 1
Wend
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton8_Click()
Unload Me
End Sub

Private Sub MultiPage1_Change()
TextBox5 = TextBoxFechaCupon

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