.
En este post voy a mostrar como mostar en el mismo listbox una suma, cantidad de registros y promedio; es decir al final de los datos del listbox se mostrará el total de la columna de ingresos, la cantidad de registros listados y un promedio; anteriormente se mostró como buscar en listbox a medida que se escribe en textbox, como pasar datos de un listbox a otro con doble click, como pasar datos de un listbox a hojas de Excel con Enter y muchos más que encontrarás en http://programarexcel.com.
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.
En el archivo se encuentra un botón que permite mostrar un formulario, al ingresar los datos necesarios en los textbox y presionar guardar se pasan inmediatamente los datos al listbox que se encuentra en el lado derecho, totalizando al último los importes del listbox, contando los registros y determinando un promedio, todo al final de los datos que se ingresaron en el listbox.
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 Las 1000 mejores macros de excel textbox combobox listbox, buscar en listbox mientras escribes en textbox, macro abre explorador de archivos de Windows, crear cartas en Word desde Excel 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()
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
‘Elimina los totales antes de incorporar nuevo registro
If ListBox2.ListCount = 0 Then GoTo salta:
For x = 5 To 1 Step -1
ListBox2.RemoveItem ListBox2.ListCount – x
Next x
salta:
‘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
ListBox2.AddItem
ListBox2.AddItem
ListBox2.AddItem
ListBox2.List(ListBox2.ListCount – 1, 0) = «Total en $»
Dim t As Single, tot As Single
bb = ListBox2.ListCount – 1
For x = 0 To ListBox2.ListCount – 1
t = ListBox2.List(x, 5)
tot = tot + t
t = 0
Next x
ListBox2.List(ListBox2.ListCount – 1, 1) = Format(tot, «#,##0.00;-#.##0,00»)
ListBox2.AddItem
ListBox2.List(ListBox2.ListCount – 1, 0) = «Registros»
ListBox2.List(ListBox2.ListCount – 1, 1) = ListBox2.ListCount – 4
ListBox2.AddItem
ListBox2.List(ListBox2.ListCount – 1, 0) = «Promedio»
ListBox2.List(ListBox2.ListCount – 1, 1) = Format(tot / (ListBox2.ListCount – 5), «#,##0.00;-#.##0,00»)
‘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
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
‘Elimina los totales antes de incorporar nuevo registro
If ListBox2.ListCount = 0 Then GoTo salta:
For x = 5 To 1 Step -1
ListBox2.RemoveItem ListBox2.ListCount – x
Next x
salta:
‘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
ListBox2.AddItem
ListBox2.AddItem
ListBox2.AddItem
ListBox2.List(ListBox2.ListCount – 1, 0) = «Total en $»
Dim t As Single, tot As Single
bb = ListBox2.ListCount – 1
For x = 0 To ListBox2.ListCount – 1
t = ListBox2.List(x, 5)
tot = tot + t
t = 0
Next x
ListBox2.List(ListBox2.ListCount – 1, 1) = Format(tot, «#,##0.00;-#.##0,00»)
ListBox2.AddItem
ListBox2.List(ListBox2.ListCount – 1, 0) = «Registros»
ListBox2.List(ListBox2.ListCount – 1, 1) = ListBox2.ListCount – 4
ListBox2.AddItem
ListBox2.List(ListBox2.ListCount – 1, 0) = «Promedio»
ListBox2.List(ListBox2.ListCount – 1, 1) = Format(tot / (ListBox2.ListCount – 5), «#,##0.00;-#.##0,00»)
‘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
.
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