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

Respuesta
1

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 Sub

Agregué 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.

No me ha llegado.

¿Me ayudas mandándolo también a estos correos?

[email protected]

[email protected]

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.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas