Hoy vamos a aprender cómo añadir varios registros a un subformulario mediante un formulario con selección múltiple usando VBA.
Esto es útil si disponemos de un listado, ya sea de materiales, servicios, personas... y queremos seleccionar varios registros para añadirlos de una sola vez al subformulario en lugar de tener que hacerlo uno a uno.
Para ello, he preparado un ejemplo (adjunto al final del post) en el que encontramos una tabla llamada "Servicios" con varios registros.
También, usaremos la tabla "Temporal Servicios", en la que iremos añadiendo servicios conforme los seleccionemos en el formulario de selección múltiple. Asimismo, nos servirá para calcular el coste.
Por otro lado, el formulario "Presupuesto" incluye el subformulario "Presupuesto_SubServicios" y en él visualizaremos los servicios añadidos al presupuesto.
Finalmente, para añadir servicios, usaremos el formulario "Añadir servicio".
En realidad, el código de VBA que nos interesa es el que lleva este último formulario, que va a controlar la selección múltiple de registros.
En primer lugar, al cargar el formulario, blanqueamos los campos "Horas" y "Seleccion" de la tabla "Servicios", para eliminar datos de cargas anteriores.
Private Sub Form_Load()
DoCmd.SetOrderBy "Servicio ASC"
'Blanqueamos la columna seleccion y horas de la tabla Servicios
Dim dbs As DAO.Database
Set dbs = CurrentDb()
dbs.Execute "UPDATE Servicios Set Horas='" & "" & "'"
dbs.Execute "UPDATE Servicios Set Seleccion='" & "" & "'"
End Sub
En segundo lugar, encontramos el código implementado en el evento "Al hacer clic" del botón Añadir, y que va a pasar los registros seleccionados al subformulario "Presupuesto_SubServicios" del formulario "Presupuesto".
Private Sub Añadir_Click()
Form.Refresh
'Seleccionamos los registros de la tabla Servicios que hayamos seleccionado
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("Select * From Servicios where seleccion=True")
'Para cada uno de esos registros realizamos las siguientes operaciones
Do While Not rs.EOF
'Comprobamos que se ha rellenado el campo Horas
If (IsNull(rs!Horas) Or IsEmpty(rs!Horas)) And rs!Seleccion = True Then
MsgBox "Es necesario rellenar el campo horas"
GoTo error
End If
'Si ya hemos añadido el servicio hacemos un update, en caso contrario un insert
serv = DLookup("[Servicio]", "[Temporal Servicios]", "[Servicio] = '" & rs!Servicio & "'")
If IsNull(serv) Or IsEmpty(serv) Then
cSql = "Insert InTo [Temporal Servicios] (Servicio,horas,[precio coste],[precio total], PVP,[precio total pvp])" & _
"values ('" & rs!Servicio & "','" & rs!Horas & "','" & rs![Precio coste] & "','" & rs![Precio coste] * [Horas] & "','" & rs!PVP & "','" & rs![PVP] * [Horas] & "')"
CurrentDb.Execute cSql
Else
DoCmd.SetWarnings False
Form.Refresh
DoCmd.RunSQL "Update [Temporal Servicios] set [Horas]='" & rs!Horas & "',[Precio Total]='" & rs![Precio coste] & "' * '" & rs!Horas & "',[Precio Total PVP]='" & rs!PVP & "' * '" & rs!Horas & "' where [Servicio]='" & rs!Servicio & "'"
DoCmd.SetWarnings True
End If
Forms![Presupuesto]!Presupuesto_SubServicios.Requery
rs.MoveNext
Loop
rs.Close
Forms![Presupuesto]!Presupuesto_SubServicios.Requery
'Actualizamos el totalizador de servicios
Dim dbs As DAO.Database
Dim suma As Recordset
Dim suma2 As Recordset
Set dbs = CurrentDb()
Set suma = dbs.OpenRecordset("Select SUM([Precio Total]) as importeservicios from [Temporal Servicios]")
Set suma2 = dbs.OpenRecordset("Select SUM([Precio Total PVP]) as importeserviciosPVP from [Temporal Servicios]")
Forms![Presupuesto]!TotalServicios = suma!importeservicios
Forms![Presupuesto]!TotalServiciosPVP = suma2!importeserviciosPVP
DoCmd.Close
error:
End Sub
Vamos a ver cómo funciona el programa y el código paso a paso.
Para empezar, pulsa el botón Añadir servicio en el formulario "Presupuesto" y rellena el formulario "Añadir servicio" de la siguiente manera.
El formulario "Añadir servicio" está asociado a la tabla "Servicios". De esta manera, cuando los seleccionamos e introducimos las horas de cada uno de ellos, estamos escribiendo directamente en la tabla.
Por eso, lo primero que hacemos es un recordset con los registros de la tabla "Servicios" que tienen el check del campo Seleccion en True.
'Seleccionamos los registros de la tabla Servicios que hayamos seleccionado
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("Select * From Servicios where seleccion=True")
A continuación, pulsamos el botón Añadir. Seguidamente, vemos que se han añadido 3h de albañilería y 5h de fontanería en el formulario "Presupuesto".
Si volvemos a pulsar Añadir Servicio, y seleccionamos un servicio introducido previamente como el de Albañilería, el programa lo va a detectar y va a actualizar el campo horas con el nuevo valor.
Sin embargo, si el servicio no había sido añadido previamente, lo insertará con su correspondiente valor de horas.
También, comprobamos que esté relleno el campo "Horas" para los servicios seleccionados. A continuación, te dejo el link donde explico con más detalle cómo comprobar si se ha rellenado un campo obligatorio usando VBA, por si te interesa.
'Para cada uno de esos registros realizamos las siguientes operaciones
Do While Not rs.EOF
'Comprobamos que se ha rellenado el campo Horas
If (IsNull(rs!Horas) Or IsEmpty(rs!Horas)) And rs!Seleccion = True Then
MsgBox "Es necesario rellenar el campo horas"
GoTo error
End If
'Si ya hemos añadido el servicio hacemos un update, en caso contrario un insert
serv = DLookup("[Servicio]", "[Temporal Servicios]", "[Servicio] = '" & rs!Servicio & "'")
If IsNull(serv) Or IsEmpty(serv) Then
cSql = "Insert InTo [Temporal Servicios] (Servicio,horas,[precio coste],[precio total], PVP,[precio total pvp])" & _
"values ('" & rs!Servicio & "','" & rs!Horas & "','" & rs![Precio coste] & "','" & rs![Precio coste] * [Horas] & "','" & rs!PVP & "','" & rs![PVP] * [Horas] & "')"
CurrentDb.Execute cSql
Else
DoCmd.SetWarnings False
Form.Refresh
DoCmd.RunSQL "Update [Temporal Servicios] set [Horas]='" & rs!Horas & "',[Precio Total]='" & rs![Precio coste] & "' * '" & rs!Horas & "',[Precio Total PVP]='" & rs!PVP & "' * '" & rs!Horas & "' where [Servicio]='" & rs!Servicio & "'"
DoCmd.SetWarnings True
End If
Forms![Presupuesto]!Presupuesto_SubServicios.Requery
rs.MoveNext
Loop
rs.Close
Forms![Presupuesto]!Presupuesto_SubServicios.Requery
Por último, actualizamos los totalizadores de precio que se encuentran en el pie del formulario.
'Actualizamos el totalizador de servicios
Dim dbs As DAO.Database
Dim suma As Recordset
Dim suma2 As Recordset
Set dbs = CurrentDb()
Set suma = dbs.OpenRecordset("Select SUM([Precio Total]) as importeservicios from [Temporal Servicios]")
Set suma2 = dbs.OpenRecordset("Select SUM([Precio Total PVP]) as importeserviciosPVP from [Temporal Servicios]")
Forms![Presupuesto]!TotalServicios = suma!importeservicios
Forms![Presupuesto]!TotalServiciosPVP = suma2!importeserviciosPVP
Espero que hayas aprendido con este ejemplo cómo añadir varios registros a un subformulario mediante un formulario con selección múltiple usando VBA.
Hasta la próxima.
Descarga el archivo del ejemplo
Quizá te interese,
0 comentarios