Folio consecutivo en vba excel userform, que cuando se de en registrar me muestre en un cuadro el numero de folio registrado?
Tengo un problema en un formulario que me sirve para registrar los productos que van entrando a la empresa, actualmente se maneja de esta manera cuando entra un producto se captura en el formulario creado, cuando se clic en el botón registrar este guarda todos los datos en una hoja de Excel empezando desde la columna “B”. Toda la fila a de arriba para abajo esta foliada personalizada mente de esta manera BM1, BM2, BM3 y así sucesivamente conforme se van capturando los datos.
Lo que quiero hacer es que, desde el formulario al dar registrar, una nueva entrada me saque un cuadro de dialogo en donde me diga que número de folio consecutivo se le dio a ese registro. Es decir que, si el último registro tuvo un folio BM3, que el siguiente sea el BM4 me lo muestre en un cuadro de dialogo al dar en registrar y me lo capture en la hoja donde se guardan los registros en otra columna más.
Espero me allá podido explicar. Muchas gracias.
Esta es la captura en donde se van guardando los registros, acutualmente hay 30162 registros capturados, lo que se pone manual es la columan "A" la que son los folios Personalizados BMXXX
Por lo que entiendo el folio (columna A) no lo resuelve en automático, ¿cierto?
¿Lo qué buscas es que sólo te dé el folio o bien que además lo grabé en la Celda correspondiente?
Me ayuda si me proporcionas tu código. Si no es posible por alguna razón con responderme las dos preguntas anteriores creo que lo podemos resolver.
Hola es correcto la columna "A" no lo resuelve en automático. busco que me de el folio que sigue y lo grabe en la celda correspondiente. junto con los demás datos del formulario y de igual manera que en una etiqueta en el formulario me muestre el folio siguiente es decir el folio que corresponde a esa captura.
el folio necesito que quede esta maneara EJEMPLO: BM30129 si es muy complicado solo con los numero.
te agradezco mucho me puedas ayudar
Private Sub boton_fecha_Click()
txtfecha = Date
End Sub
Private Sub btcalendario_Click()
senal = 0
senal = 1
rutinas.Mostarcalendario '2 Paso
End Sub
Private Sub ComboBox1_Change()
End Sub
Private Sub CommandButton1_Click()
Dim Fila As Integer
Dim Final As Integer
Dim Registro As Integer
Dim Titulo As String
Titulo = "Gestor de Inventarios"
'Validando los controles sin datos
If Me.txt_numerofac = "" Then
Me.txt_numerofac.BackColor = &HC0C0FF
MsgBox "Debe ingresar una numero de factura", , Titulo
Me.txt_numerofac.SetFocus
Exit Sub
ElseIf Me.txt_descripcion = "" Then
Me.txt_descripcion.BackColor = &HC0C0FF
MsgBox "Debe ingresar una descripción", , Titulo
Me.txt_descripcion.SetFocus
Exit Sub
ElseIf Me.ComboBox1 = "" Then
Me.ComboBox1.BackColor = &HC0C0FF
MsgBox "Debe ingresar un centro de costo", , Titulo
Me.ComboBox1.SetFocus
Exit Sub
ElseIf Me.Txt_color = 0 Then
Me.Txt_color.BackColor = &HC0C0FF
MsgBox "Debe ingresar el Color", , Titulo
Me.Txt_color.SetFocus
Exit Sub
ElseIf Me.txt_serie = 0 Then
Me.txt_serie.BackColor = &HC0C0FF
MsgBox "Debe ingresar un numero de serie", , Titulo
Me.txt_serie.SetFocus
Exit Sub
ElseIf Me.txt_marca = 0 Then
Me.txt_marca.BackColor = &HC0C0FF
MsgBox "Debe ingresar un numero de marca", , Titulo
Me.txt_marca.SetFocus
Exit Sub
ElseIf Me.txt_CostoUnitario = 0 Then
Me.txt_CostoUnitario.BackColor = &HC0C0FF
MsgBox "Debe ingresar un precio", , Titulo
Me.txt_CostoUnitario.SetFocus
Exit Sub
ElseIf Me.txt_PrecioVenta = 0 Then
Me.txt_PrecioVenta.BackColor = &HC0C0FF
MsgBox "Debe ingresar un precio", , Titulo
Me.txt_PrecioVenta.SetFocus
Exit Sub
End If
'Determina el final del listado de productos
For Fila = 1 To 9000
If Hoja2.Cells(Fila, 2) = "" Then
Final = Fila
Exit For
End If
Next
If MsgBox("Son correctos los datos?" + Chr(13) + "Desea proceder?", vbOKCancel) = vbOK Then
'Envía los datos a la hoja de productos
Hoja2.Cells(Final, 2) = Me.txt_numerofac
Hoja2.Cells(Final, 3) = Me.txt_descripcion
Hoja2.Cells(Final, 4) = Me.ComboBox1
Hoja2.Cells(Final, 5) = Me.Txt_color
Hoja2.Cells(Final, 6) = Me.Txtncalendario
Hoja2.Cells(Final, 7) = Me.txt_serie
Hoja2.Cells(Final, 8) = Me.txt_marca
Hoja2.Cells(Final, 9) = Me.txtfecha
Hoja2.Cells(Final, 10) = Me.txt_CostoUnitario
Hoja2.Cells(Final, 11) = Me.txt_PrecioVenta
Hoja2.Cells(Final, 12) = Hoja8.Range("G1") 'Usuario responsalbe de la operación
'-----------------------------------------------
'Envía los datos a la hoja de existencias
'-----------------------------------------------
'Limpia los controles
Me.txt_descripcion = ""
Me.Txtncalendario = ""
Me.txt_CostoUnitario = ""
Me.txt_PrecioVenta = ""
Me.Txt_color = ""
Me.txt_serie = ""
Me.txt_marca = ""
Me.txtfecha = ""
Me.txt_numerofac = ""
Me.ComboBox1 = ""
Else
Exit Sub
End If
End Sub
Jhone;
Te mando lo que trabajé, desde mi punto de vista debería funcionar según lo que vi en el código que me enviaste. Aunque me ayudaría si me mandas el Libro aunque sea con datos inventados para probarlo o corregir en caso de que no te funciones. Mi correo [email protected]
Private Sub boton_fecha_Click()
txtfecha = Date
End Sub
Private Sub btcalendario_Click()
senal = 0
senal = 1
rutinas.Mostarcalendario '2 Paso
End Sub
Private Sub ComboBox1_Change()
End Sub
Private Sub CommandButton1_Click()
Dim Fila As Integer
Dim Final As Integer
Dim Registro As Integer
Dim Titulo As String
Titulo = "Gestor de Inventarios"
'Validando los controles sin datos
If Me.txt_numerofac = "" Then
Me.txt_numerofac.BackColor = &HC0C0FF
MsgBox "Debe ingresar una numero de factura", , Titulo
Me.txt_numerofac.SetFocus
Exit Sub
ElseIf Me.txt_descripcion = "" Then
Me.txt_descripcion.BackColor = &HC0C0FF
MsgBox "Debe ingresar una descripción", , Titulo
Me.txt_descripcion.SetFocus
Exit Sub
ElseIf Me.ComboBox1 = "" Then
Me.ComboBox1.BackColor = &HC0C0FF
MsgBox "Debe ingresar un centro de costo", , Titulo
Me.ComboBox1.SetFocus
Exit Sub
ElseIf Me.Txt_color = 0 Then
Me.Txt_color.BackColor = &HC0C0FF
MsgBox "Debe ingresar el Color", , Titulo
Me.Txt_color.SetFocus
Exit Sub
ElseIf Me.txt_serie = 0 Then
Me.txt_serie.BackColor = &HC0C0FF
MsgBox "Debe ingresar un numero de serie", , Titulo
Me.txt_serie.SetFocus
Exit Sub
ElseIf Me.txt_marca = 0 Then
Me.txt_marca.BackColor = &HC0C0FF
MsgBox "Debe ingresar un numero de marca", , Titulo
Me.txt_marca.SetFocus
Exit Sub
ElseIf Me.txt_CostoUnitario = 0 Then
Me.txt_CostoUnitario.BackColor = &HC0C0FF
MsgBox "Debe ingresar un precio", , Titulo
Me.txt_CostoUnitario.SetFocus
Exit Sub
ElseIf Me.txt_PrecioVenta = 0 Then
Me.txt_PrecioVenta.BackColor = &HC0C0FF
MsgBox "Debe ingresar un precio", , Titulo
Me.txt_PrecioVenta.SetFocus
Exit Sub
End If
'Determina el final del listado de productos
For Fila = 1 To 9000
If Hoja2.Cells(Fila, 2) = "" Then
Final = Fila
Exit For
End If
Next
If MsgBox("Son correctos los datos?" + Chr(13) + "Desea proceder?", vbOKCancel) = vbOK Then
'Envía los datos a la hoja de productos
Hoja2.Cells(Final, 2) = Me.txt_numerofac
Hoja2.Cells(Final, 3) = Me.txt_descripcion
Hoja2.Cells(Final, 4) = Me.ComboBox1
Hoja2.Cells(Final, 5) = Me.Txt_color
Hoja2.Cells(Final, 6) = Me.Txtncalendario
Hoja2.Cells(Final, 7) = Me.txt_serie
Hoja2.Cells(Final, 8) = Me.txt_marca
Hoja2.Cells(Final, 9) = Me.txtfecha
Hoja2.Cells(Final, 10) = Me.txt_CostoUnitario
Hoja2.Cells(Final, 11) = Me.txt_PrecioVenta
Hoja2.Cells(Final, 12) = Hoja8.Range("G1") 'Usuario responsalbe de la operación
'----- Recuperación de Folio y Messagebox con el mismo
Dim folioAnterior As String
Dim folioNuevo As String
folioAnterior = Hoja2.Cells(Final - 1, 1).Value
folioAnterior = Right(folioAnterior, Len(folioAnterior) - 2)
folioNuevo = CStr(CInt(folioAnterior) + 1)
folioNuevo = "BM" & folioNuevo
Hoja2.Cells(Final, 1) = folioNuevo
MsgBox Prompt:="Se grabó el folio " & folioNuevo, Title:="Registro grabado"
'----- Termina sección de Folio y Messagebox
'-----------------------------------------------
'Envía los datos a la hoja de existencias
'-----------------------------------------------
'Limpia los controles
Me.txt_descripcion = ""
Me.Txtncalendario = ""
Me.txt_CostoUnitario = ""
Me.txt_PrecioVenta = ""
Me.Txt_color = ""
Me.txt_serie = ""
Me.txt_marca = ""
Me.txtfecha = ""
Me.txt_numerofac = ""
Me.ComboBox1 = ""
Else
Exit Sub
End If
End SubAgregué la sección que comenté como Recuperación de Folio.
Hola de nuevo te mande el archivo a tu correo ya que no funciono para que puedas ver muchísimas gracias estamos en contacto por correo.
Ya te e reenviado el archivo a los correos
Jhonatan;
Ya te envíe de vuelta el archivo con las correcciones, ¿lo revisas de favor?
En caso de haber funcionado.
