Bueno, ahí esta la macro terminada, creo que puede ser útil para alguno... aunque supongo que pronto subiré la base de datos al completo...
Voy a explicar también un poquito como trabaja la macro, si alguien quiere contestar con alguna sugerencia, queja o consulta será bien recibida.
Para empezar:
- El formulario no está vinculado a ninguna Tabla, ni consulta, ni sentencia SQL.
- Existen controles campos de texto para cada dato que se introducirá en las tablas, salvo uno de fecha y dos de listados.
las Tablas en cuestión implicadas son varias:
- Personas (Tabla que registra personas)
- Vehiculos (Tabla que registra vehículos)
- Vinculacion personas vehiculos (Tabla que registra relaciones entre personas y vehiculos, en relación muchos con muchos, ademas una persona puede estar relacionada al mismo vehículo varias veces, con distinto tipo de vinculo (conductor, pasajero, propietario...))
- Documentos de Identificacion (Una persona puede tener varios documentos de identificacion (DNI, PASAPORTE, Tarjeta sanitaria, etc...), por tanto se necesita una tabla aparte)
- Alias de persona (Los motes que puede tener una persona en concreto)
Existen otra tablas como
- Tipo de documento. (esta tabla no la empleo para evitar complejidad, se entiende que el documento introducido es DNI (id=0))
Y luego las usadas en los listados
- Tipo de Vehiculos (moto, coche, etc...)
- Tipo Vinculacion Personas con Vehiculos (ya explicado, conductor, pasajero...)
¿ Como se rellenan los listados ?, pues con el siguiente macro que se inicia al cargar el formulario:
Código: Seleccionar todo
Sub ER_IniciarListados(Evento as Object)
Dim oForm as Object, Listado as Object, sSQL as string
oForm=Evento.Source
Listado=oForm.getByName("LstVinculo")
sSQL="SELECT ""TipoVinculacionPersoVehi"", ""Id"" FROM ""Tipo Vinculacion Personas con Vehiculos"" ORDER BY ""TipoVinculacionPersoVehi"" ASC"
Rellena_ListBox (Listado, sSQL)
if Ubound(Listado.ListSource)>0 then Listado.SelectedItems=Array(Listado.ListSource(2))
' Ojo, establecido el orden, el valor por defecto "Conductor", se encuentra en la posicion 2
Listado=oForm.getByName("LstTipo")
sSQL="SELECT ""TipoDeVehiculo"", ""Id"" FROM ""Tipo de Vehiculos"" "
Rellena_ListBox (Listado, sSQL)
if Ubound(Listado.ListSource)>0 then Listado.SelectedItems=Array(Listado.ListSource(0))
' Ojo, establecido el orden, el valor por defecto "Turismo", se encuentra en la posicion 0
End Sub
Sub Rellena_ListBox(oControl as Object, sSQL as string, Optional MostrarError as boolean)
' Rellena listados incluyendo Texto y Ids, para ello hay que enviar una consulta SQL donde el primer
' campo será el texto a rellenar y el segundo el Id (u otra información que deba almacenar el control)
If IsMissing(MostrarError) then MostrarError=true
dim oStat As Object, oRes As Object
oStat=ThisDatabaseDocument.CurrentController.ActiveConnection.CreateStatement()
oStat.setPropertyvalue("ResultSetType", com.sun.star.sdbc.ResultSetType.SCROLL_SENSITIVE)
oRes=oStat.executeQuery(sSQL)
Dim VarItems() As String, VarTexto() as String, Posicion as integer
Posicion=0
If Not IsNull(oRes) Then
While oRes.next
redim preserve VarItems(posicion)
redim preserve varTexto(posicion)
VarItems(posicion)=str(oRes.getInt(2)) ' Id
VarTexto(posicion)=oRes.getString(1) ' Tipo de Vinculacion
posicion=posicion+1
Wend
oControl.StringItemList=VarTexto() 'Informacion adicional
oControl.ListSource=VarItems()
'listado.SelectedItems=VarTexto
else
if MostrarError then msgbox "Error al rellenar el ListBox ("+oControl.name+"), la base de datos no contine registros",16,"Error"
endif
End sub
Como detalle, se puede observar como a cada campo listado, ademas del texto a mostrar, introduzco en cada opción un dato extra, el id del registro.
El Procedimiento
ER_IniciarListados se encarga de localizar los ListBox a rellenar, construir las sentencias SQL, enviarlas al procedimiento
Rellena_ListBox para rellenar cada listado con el resultado de esa sentencia SQL y luego añade un valor por defecto (esto ultimo no es necesario)
Ahora el meollo de la cuestión, la macro encargada de introducir los datos. Ojo, como veréis, se comprueba si existe la necesidad de introducir un registro en
Personas, o/y introducirlo en
Vehiculos o si es necesario realizar la vinculación:
Código: Seleccionar todo
Sub CrearRegistros (Evento as Object)
Dim oForm as Object
oForm=Evento.Source.model.parent
Dim NombreCampos as String, DatosCampos as string
Dim sSQL As String, oStat As Object, oRes As Object
Dim IdPersona as integer, IdVehiculo as integer, Introducidos as integer
Introducidos=0
NombreCampos="": DatosCampos=""
CompruebaRegistro ("Nombre","TxtNombre",oForm,NombreCampos,DatosCampos)
CompruebaRegistro ("Apellido_1","TxtApellido1",oForm,NombreCampos,DatosCampos)
CompruebaRegistro ("Apellido_2","TxtApellido2",oForm,NombreCampos,DatosCampos)
CompruebaRegistro ("Fecha_Nac","TxtFecha",oForm,NombreCampos,DatosCampos)
CompruebaRegistro ("Notas","TxtNotasPersona",oForm,NombreCampos,DatosCampos)
if NombreCampos<>"" then
' Metemos personas
sSQL="INSERT INTO ""Personas"" ("+NombreCampos+") VALUES ("+DatosCampos+"); Call Identity()"
oStat=ThisDatabaseDocument.CurrentController.ActiveConnection.CreateStatement()
oRes=oStat.executeQuery(sSQL)
If Not IsNull(oRes) then
Introducidos=Introducidos+1
oRes.Next
IdPersona=oRes.GetInt(1)
else
msgbox "Error al introducir la persona": exit sub
endif
' Entrada de DNI o Alias de existir.
if oForm.getByName("TxtDNI").text<>"" then
sSQL="INSERT INTO ""Documentos de Identificacion"" (""IdPersona"",""IdTipo"",""Numero"") VALUES ("+IdPersona+",0,'"+oForm.getByName("TxtDNI").text+"')"
oRes=oStat.executeQuery(sSQL)
endif
if oForm.getByName("TxtAlias").text<>"" then
sSQL="INSERT INTO ""Alias de Personas"" (""IdPersona"",""Alias"") VALUES ("+IdPersona+",'"+oForm.getByName("TxtAlias").text+"')"
oRes=oStat.executeQuery(sSQL)
endif
else
' Error al meter datos en base, advertir por si acaso de que el registro de persona no ha sido introducido
if oForm.getByName("TxtDNI").text<>"" then msgbox "No basta con introducir DNI, hay que incluir otro dato sobre la persona.",16,"No se puede añadir el registro": Exit sub
if oForm.getByName("TxtAlias").text<>"" then msgbox "No basta con introducir Alias, hay que incluir otro dato sobre la persona.",16,"No se puede añadir el registro": Exit sub
endif
' Metemos Vehiculo
NombreCampos="": DatosCampos=""
CompruebaRegistro ("Matricula","TxtMatricula",oForm,NombreCampos,DatosCampos)
CompruebaRegistro ("Marca","TxtMarca",oForm,NombreCampos,DatosCampos)
CompruebaRegistro ("Modelo","TxtModelo",oForm,NombreCampos,DatosCampos)
CompruebaRegistro ("Notas","TxtNotasVehiculo",oForm,NombreCampos,DatosCampos)
if NombreCampos<>"" then
CompruebaRegistro ("IdTipo","LstTipo",oForm,NombreCampos,DatosCampos)
' Metemos el vehiculo
sSQL="INSERT INTO ""Vehiculos"" ("+NombreCampos+") VALUES ("+DatosCampos+"); Call Identity()"
oStat=ThisDatabaseDocument.CurrentController.ActiveConnection.CreateStatement()
oRes=oStat.executeQuery(sSQL)
If Not IsNull(oRes) then
Introducidos=Introducidos+1
oRes.Next
IdVehiculo=oRes.GetInt(1)
else
msgbox "Error al introducir el vehiculo": exit sub
endif
endif
if introducidos=2 then
'Vinculamos los dos
Dim vTipoVinculo as integer, indice as integer
indice=oForm.getByName("LstVinculo").SelectedItems(0)
vTipoVinculo=oForm.getByName("LstVinculo").ValueItemList(indice)
sSQL="INSERT INTO ""Vinc Personas-Vehiculos"" (""IdPersona"", ""IdVehiculo"", ""TipoDeVinculo"") VALUES ("+IdPersona+","+IdVehiculo+","+vTipoVinculo+")"
oRes=oStat.executeQuery(sSQL)
endif
if introducidos>0 then msgbox "Registro Introducido",64,"Información": LimpiaEntradas (oForm)
End Sub
Sub CompruebaRegistro (ByVal NCampo as string, ByVal NControl as string,ByRef oForm as object, ByRef NombreCampos as string, ByRef DatosCampos as string)
Dim DatoIntroducido as string
If NControl<>"LstTipo" then
DatoIntroducido=oForm.getByName(NControl).text
else
DatoIntroducido="Valor en Listado"
endif
if DatoIntroducido<>"" then
if NombreCampos<>"" then
NombreCampos=NombreCampos+", "
DatosCampos=DatosCampos+", "
endif
NombreCampos=NombreCampos+""""+NCampo+""""
Select Case NCampo
Case "Fecha_Nac":
DatosCampos=DatosCampos+"'"+Format(oForm.getByName(NControl).text,"YYYY-MM-DD")+"'"
Case "IdTipo":
Dim indice as integer
indice=oForm.getByName(NControl).SelectedItems(0)
DatosCampos=DatosCampos+oForm.getByName(NControl).ValueItemList(indice)
Case Else:
DatosCampos=DatosCampos+"'"+oForm.getByName(NControl).text+"'"
end Select
endif
End Sub
Sub LimpiaEntradas(ByRef oForm as Object)
oForm.getByName("TxtNombre").text=""
oForm.getByName("TxtApellido1").text=""
oForm.getByName("TxtApellido2").text=""
oForm.getByName("TxtFecha").text=""
oForm.getByName("TxtNotasPersona").text=""
oForm.getByName("TxtDNI").text=""
oForm.getByName("TxtAlias").text=""
oForm.getByName("TxtMarca").text=""
oForm.getByName("TxtModelo").text=""
oForm.getByName("TxtMatricula").text=""
oForm.getByName("TxtNotasVehiculo").text=""
End Sub
La función
CrearRegistros, debe estar enlazada al botón del formulario designado para proceder a introducir los datos.
La función
CrearRegistros, llama a la función
CompruebaRegistro, que es la que se encarga de comprobar el dato introducido en el campo de texto, para así ir creando la consulta SQL de ser necesario. La función
CompruebaRegistro la he creado para que el código sea más limpio.
Al final de crear el registro, se limpian los campos de texto, con la función
LimpiaEntradas.
En el código, se ve claro los nombres de los controles empleados y los nombres de los campos de la base de datos.
Lo suyo, sería que antes de introducir los datos en la base de datos, se comprobaran si existe la persona o vehiculo, ya en base, para evitar duplicados. No lo he hecho para evitar complejidad, quizás más adelante.
Espero que sea de utilidad.
Nota: Queda pendiente, si alguien sabe alguna forma de introducir los registros mediante instrucciones SQL anidadas, a fin de evitar el procedimiento "Select Max(id)"....