Números correlativos automáticos por fecha
Tengo una base de datos mdb. En visual basic he hechos los formularios con barras de menús para guardar, buscar, imprimir y eliminar los registros de base.
Quisiera saber como puedo guardar un registro en la base a través del formulario y que al guardar el registro me busque en el campo clave si existe algún archivo con el año en curso y automáticamente le asigne el siguiente si existe o el primero si no existe. Tengo un DTPicker como campo fecha en el formulario para que a través de el sepa el año. Ejemplo: que en el campo expte salga 0001/2015 y así sucesivamente y al cambiar de año empiece de nuevo en el 0001/2016.
1 Respuesta
Hola,
Este código sirve para visual basic de acces. Yo lo necesito para Visual basic 6 ya que es con este programa con el que estoy haciéndolo.
Podrías ayudarme?
Un saludo.
Disculpa, al ver que usabas una base de datos mdb, pensé que trabajabas con access...
El código de visual basic para aplicaciones es un tipo "particular" del código visual basic, por tanto, te debiera funcionar cambiando las referencias a los cuadros de texto del formulario de Access (los que empiezan por Me.) Por las referencias a los cuadros de texto de tu formulario.
Como en Visual Basic no existe la función DMax, para obtener el último correlativo, tendrás que ordenar los registros por el correlativo, moverte al último y coger su valor, para luego sumarle una unidad:
Mañana probare a ver si me sale. De todas formas este es el código que tenía en una base de datos de acces.
En un módulo:
Option Explicit
Public MiBase As Database
Public MiTabla As Recordset ' Tablas
Public Sub EnlazarBase()
Dim Ruta As String
Ruta = "" & App.Path & "\Operaciones.mdb"
Set MiBase = OpenDatabase(Ruta)
Set MiTabla = MiBase.OpenRecordset("UNIDADES")
Set MiTabla = MiBase.OpenRecordset("ENTRADA")
End Sub
En la barra de menus en en select case "guardar"
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComCtlLib.Button)
On Error Resume Next
Select Case Button.Key
Case "Nuevo"
'TareasPendientes: Agregar código de botón 'Nuevo'.
MsgBox "Agregar código de botón 'Nuevo'."
Case "Guardar"
Call EnlazarBase
Dim rs As Recordset
Dim txtSql As String
Dim n As Integer
txtSql = "select max(NUMEXPTE)as maxNum from ENTRADA" & _
"where NUMEXPTE like '*/" & Format$(Me.DTPicker1, "yyyy") & """"
Set rs = CurrentDb().OpenRecordset(txtSql)
rs.MoveFirst
If IsNull(rs!maxnum) Then
n = 0
Else
n = Val(Left$(rs!maxnum, 3))
End If
rs.Close
guardar.NUMEXPTE = Format$(n + 1, "000") & "/" & Format$(Me.DTPicker1, "yyyy")
rs.Update
MsgBox "Registro Guardado"
Case "Buscar"
Case "Imprimir"
Case "Eliminar"
End Select
End Sub
Con esto en el campo texto me sale 0001/2015, pero no lo guarda en la base de datos.
Un saludo.
El código ese no te guarda porque en ningún sitio se lo indicas (con el fragmento de código que pones). Además, en el procedimiento EnlazarBase, no estás enlazando dos tablas, sino sólo una, la última (ENTRADA)
Si es en esta donde quieres guardar el correlativo, despues del rs. Close te faltaría añadir algo como esto:
MiTabla. AddNew
MiTabla("NUMEXPTE")= Format$(n + 1, "000") & "/" & Format$(Me.DTPicker1, "yyyy")
MiTabla.Update
y borrar estas dos lineas:
guardar.NUMEXPTE = Format$(n + 1, "000") & "/" & Format$(Me.DTPicker1, "yyyy")
rs.Update
Si te fijas, la estructura general del código es la misma que los que te proponía:
1º/ Buscas el último correlativo, si no hay ninguno lo inicias en 0
2º/ Le sumas una unidad
3º/ Lo asignas al cuadro de texto/lo guardas en la tabla
Gracias. Mañana si puedo cambio el código por el que tú me indicas. Ya te contaré.
Un saludo.
Ten en cuenta que esas modificaciones al código de tu access las hago viendo sólo una parte del código, y puede que se me escape alguna cosa. Por ejemplo, no entiendo de dónde te viene esta parte: guardar.NUMEXPTE...
Hola, he cambiado el código pero no hace nada.
Te explico lo que quiero hacer:
Tengo una base de datos en access y en ella varias tablas con campos, texto, numérico, fecha y memo.
En visual basic 6 he creado formularios con barras de menús (nuevo, guardar, buscar, imprimir) para ingresar datos desde ellos hacia las tablas.
Lo que quiero es que cuando yo rellene el formulario el darle click al boton del menu "guardar", ingrese los datos en la tabla y en el campo NUMEXPTE de dicha tabla aparezca "0001/2015", al igual que en el textbox del formulario (llamado EXPTE) que debe aparecer "0001/2015" recogiendo el año dependiendo de la fecha del DTPicker del formulario. Y que automáticamente vaya asignando 1 más al que exite ya en la tabla, y que al cambiar de año comience de nuevo en el "0001/2016".
Espero haberme explicado.
El código que te puse lo tenía en esa misma base pero hecho en Visual Basic de acces; y ahora lo necesito hacer pero en Visual Basic 6.
Un saludo.
Para tratar de ayudarte, has de ser más específico. Lo que quieres hacer lo tengo claro desde el inicio, pero necesito saber lo siguiente:
Nombre de los objetos de tu formulario (el DTPICKER, el cuadro de texto ya lo indicaste)
Nombre de la tabla en la que quieres guardar los datos.
Cómo te conectas con la BD y la tabla (necesito el código que usas)
Hola,
La base y la tabla la conecto con el Módulo EnlazarBase que puse anteriormente.
La tabla se llama ENTRADA
Los objetos del formulario son muchos, tantos con campos de la tabla.
En el formulario hay un toolbar, con nuevo, guardar, buscar , imprimir.
hay txtbox1(EXPTE) , texbox2, textbox3, textbox4, textbox5, combo1, combo2, combo3, list1, maskedbox1, maskedbox2, DTPicker1 (para la fecha) y algunos más como éstos.
Otra cosa, para enlazar más tablas de la misma base, ¿tengo que declararlas con las variables MiTabla2, MiTabla3, etc, para que las cargue en el primer formulario del programa?.
Un saludo.
Perdona la tardanza, pero hasta hoy no me di hecho con un Visual Basic 6 que me funcionara...
He intentado reproducir tu sistema (una bd llamada BDPrueba, con una tabla llamada TDatos con los siguientes campos: ID(autonumerico), NumExp(texto), Fecha (fecha/hora) y Descripcion (texto), y un formulario en Visual Basic con 3 cuadros de texto, un selector de fecha y dos botones de comando (Nuevo y Guardar))
Pues bien, con eso y este código en el formulario (una vez agregada la referencia Microsoft DAO 3.6 Object Library), funciona perfectamente:
Option Explicit
Public MiBase As Database
Public MiTabla As Recordset ' Tablas
Public Sub EnlazarBase()
Dim Ruta As String
Ruta = App.Path & "\BDPrueba.mdb"
Set MiBase = OpenDatabase(Ruta)
Set MiTabla = MiBase.OpenRecordset("TDatos")
End Sub
Private Sub Command1_Click()
Me.Text1 = ""
Me.Text2 = ""
Me.Text3 = ""
Me.Fecha1.Text = Date
End Sub
Private Sub Command2_Click()
Dim vAutonum As Variant
Dim vUltimo As Variant
Dim rst As DAO.Recordset
Dim miSQL As String
miSQL = "SELECT NumExp FROM TDatos WHERE Right(NumExp,4)=" & Year(Me.Fecha1.FormatedText)
Set rst = MiBase.OpenRecordset(miSQL)
If rst.RecordCount = 0 Then
vUltimo = 0
Else
rst.MoveLast
vUltimo = Left(rst("NumExp"), 4)
End If
rst.Close
Set rst = Nothing
vAutonum = vUltimo + 1
Me.Text2 = Format(vAutonum, "0000") & "/" & Year(Me.Fecha1.FormatedText)
MiTabla.AddNew
MiTabla("NumExp") = Me.Text2
MiTabla("Fecha") = Me.Fecha1.FormatedText
MiTabla("Descripcion") = Me.Text3
MiTabla.Update
Me.Text1 = MiTabla("ID")
End Sub
Private Sub Form_Load()
EnlazarBase
MiTabla.MoveLast
Me.Text1 = MiTabla(0)
Me.Text2 = MiTabla(1)
Me.Text3 = MiTabla(3)
Me.Fecha1.Text = MiTabla(2)
End SubTendrás que ajustar los nombres y quizás alguna propiedad del selector de fechas..
Hola
he insertado tu código pero me da error en el modulo enlazar base.
Tengo declaradas 2 variables con 2 tablas para probar ya que la base tiene 9 tablas y quiero enlazarlas todas con primer formulario del programa.
Tengo esto
Publict mibase as database
publict mitabla as recordset
publict mitabla2 as recordset
publict enlazarbase ()
Dime ruta. ......
ruta =........
set mibase =........
y en la 1 secuencia da el error;
Set mitabla =mibase.openrecordset ("unidades ")
Set mitabla2 =mibase.openrecordset ("entrada")
ERROR
"Los tipos no coinciden"
"Los tipos no coinciden"
¿Agregaste la referencia que te comentaba (Microsoft DAO 3.6 Object Library)?
Si no es así, esta forma de conexión no te va a funcionar, y tendrás que buscar otra forma de conectarte a la BD (con ADO, por ejemplo)
https://www.dropbox.com/s/s83t3wgomojc0sc/Prueba.rar?dl=0
Te adjunto el proyecto y la BD con el que hice la prueba.
Si, agregué la librería
Pues ya no sé que decirte... ¿El archivo que te mandé, en el que hice la prueba te funciona?
Lo he probado en el trabajo, pero como tengo que hacerlo con un vb 6 portable, quizás por eso me da error.
Me da error en :
text1.formatedtext
Cuando pueda la probaré en casa
Ya te contaré
Un saludo.
Si te da error en esa línea, cambia formated text por text, a ver si así va. La versión que conseguí poner a andar de VB6 no tenía el control datapicker y me tuve que buscar un poco la vida con otro control...
El error me da aquí:
Private Sub Form_Load()
EnlazarBase
MiTabla.MoveLast
Me.Text1 = MiTabla(0)
Me.Text2 = MiTabla(1)
Me.Text3 = MiTabla(3)
Me.Fecha1.Text = MiTabla(2)
End Sub
Creo que falta alguna librería. Otra cosa ¿qué significa lo que hay entre los paréntesis, (0), (1)...?
Un saludo
Prueba poniendo solo Me.Fecha1=MiTabla(2)
Lo que hay entre los paréntesis de MiTabla es el orden de los campos en la tabla, siendo 0 el primer campo (en este caso el ID), 1 el segundo (NumExpte), 2 el tercero (la fecha) y así sucesivamente
Hola,
Mañana probaré.
Como te puedo enviar mi prueba para que la veas
Súbela a dropbox, www.filebig.net o similar y me pones aquí el enlace de descarga, o si prefieres, mándala comprimida a : [email protected]
OK, pero hasta el lunes no lo puedo mirar, que con Windows 8 no me funciona el VB 6.
Ok.
Ante todo muchas gracias
Despues de mucho pelearme con el código, encontré el error (o errores, pq eran varios):
NO te guardaba los datos en la tabla, por varios motivos:
1º/ El campo NUMEXPTE lo tienes en la tabla como tamaño 8 caracteres, mientras que le intentas dar un valor de 9 (0001/2015)
2º/ Hay campos que intentas pasar que no están en la tabla.
Además, tienes unos pequeños errores que tienes en el código:
1º/ Para coger el valor del DTPicker, has de usar: Me. DTPicker1.Value y no Me. DTPicker1. Format
2º/ Tienes un error en la SQL, te falta cerrar el paréntesis de la función right y además te falta poner el WHERE:
miSQL = "SELECT NUMEXPTE FROM ENTRADA WHERE Right(NUMEXPTE,4=)" & Year(Me.DTPicker1.Value)
http://www.filebig.net/files/DnJNEwgQdH
Ahí tienes el archivo funcionando, y te dejo dos enlaces con información sobre cómo guardar datos en access desde vb6:
https://social.msdn.microsoft.com/Forums/es-ES/402dc295-cecc-47c4-80a9-d2e095ddc337/guardar-datos-en-una-base-de-datos-en-access?forum=vbes
http://html.rincondelvago.com/programacion-con-visual-basic-y-access.html
Ok. Mañana lo probaré y ya te cuento.
Un saludo y perdón por mis torpezas.
Hola.
He probado la base y funciona pero solamente ingresa en la tabla el primer registro "0001/2015". Cuando creas otro en el formulario sigue dándote "0001/2015" y en la base no se traslada nada. Debería de salir en ambos formulario y tabla "0002/2015" y así sucesivamente.
¿Podrías decirme como hacerlo? .
Un saludo.
Había un error en el código que te mandé, en el botón de guardado.
Te pego la parte del código correspondiente corregida:
Case "Guardar"
Dim vAutonum As Variant
Dim vUltimo As Variant
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim miSQL As String
Set db = OpenDatabase(App.Path & "\Facturas.mdb")
miSQL = "SELECT NUMEXPTE FROM ENTRADA WHERE Right(NUMEXPTE,4)=" & Year(Me.DTPicker1.Value)
Set rst = db.OpenRecordset(miSQL)
If rst.RecordCount = 0 Then
vUltimo = 0
Else
rst.MoveLast
vUltimo = Left(rst("NUMEXPTE"), 4)
End If
rst.Close
Set rst = Nothing
Set rst = db.OpenRecordset("ENTRADA")
vAutonum = vUltimo + 1
Me.EXPTE = Format(vAutonum, "0000") & "/" & Year(Me.DTPicker1.Value)
rst.AddNew
rst("NUMEXPTE") = Me.EXPTE
rst("PRODUCTO") = Me.Text1
rst("ORIGEN") = Me.Text6
rst("DESTINO") = Me.Text7
rst("CANTIDAD") = Me.Text4
rst("FECHA") = Me.DTPicker1.Value
rst("HORA") = Me.MaskEdBox3
'rst("UNIDAD") = Me.Combo1 'Este campo no está en la tabla
'rst("CALIDAD") = Me.Text3 'Este campo no está en la tabla
rst.Update
Me.Text11 = rst("ID")
MsgBox "Registro Guardado"
rst.Close
Set rst = Nothing
db.Close
Set db = NothingAdemás, te recomendaría que quitases el "control" de errores que tienes (el On Error Resume Next), pues tal como lo tienes, no te avisa de los errores ni dónde se producen, con lo que se complica enormemente la tarea de depurarlos.
Hola, he probado el código e inserta el primer registro en la tabla 001/2015, pero cuando intento ingresar otro nuevo me sale un mensaje diciendo que no puede porque crearía indices repetidos. Tengo como campo clave NUMEXPTE. He repasado el código línea por línea con el tuyo y no se cual es el problema. Lo prueba con el tuyo y ningún problema.
Repasare las propiedades del campo en la tabla a ver si esta ahí el problema.
Un saludo.
Si te da error de índice repetido es porque intenta ingresar en la tabla otra vez el valor 001/2015, lo que indica que tienes algún error en tu código, y no te está cogiendo como último valor el 001/2015 para sumarle una unidad.
Revisa que tengas bien esta parte del código, sobre todo la SQL:
Set db = OpenDatabase(App.Path & "\Facturas.mdb")
miSQL = "SELECT NUMEXPTE FROM ENTRADA WHERE Right(NUMEXPTE,4)=" & Year(Me.DTPicker1.Value)
Set rst = db.OpenRecordset(miSQL)
If rst.RecordCount = 0 Then
vUltimo = 0
Else
rst.MoveLast
vUltimo = Left(rst("NUMEXPTE"), 4)
End If
Solucionado. Te envío la base con otro formulario (form7) que quiero para hacer informes bien por mes/año o por fechas.
El código me da error.
Esto ya es una cuestión nueva, por lo que deberías plantearla en otra pregunta nueva. Además, estoy de vacaciones y sin acceso a VB6.
