Filtrado de registros de un formulario a un subformulario
Me refiero a ti por que hace poco mas de dos semanas me respondiste a una cuestión, y la de hoy está relacionada con la misma.
En tu respuesta me mandaste un ejemplo que me vino perfecto para hacer lo que quería. Pues bien, para terminar de depurarlo te cuento un poco que he añadido y donde me he atascado:
Existen 2 conjutos de criterios (todos en la misma tabla), los referidos a un tipo de empresa a evaluar y los referdios a otra, por lo que a tus tablas de criterios y empresas le he añadido un campo que especifica el tipo, en la primera será un registro fijo y en la segunda lo que corresponda.
Mi pregunta es si en tu formulario llamado evaluaciones, al introducir la empresa, como ya tiene introducido el tipo de la misma, salieran en el subformulario únicamente los criterios a evaluar refereridos a ese tipo, y no todos, ya que hay muchos.
Y a colación de esto, ¿podrían esos criterios salir todos a la vez (como en una tabla) y no tener que elegirlos de un deplegable uno por uno?, es que al haber tantos es fácil perderte y equivocarte al ponerle la nota.
1 Respuesta
Te adjunto la BD de ejemplo actualizada a la nueva consulta.
http://www.filebig.net/files/NWi4NGkcES
Te explico los cambios que le hice yo:
1º/ a la tabla Criterios le añadí un campo Tipo (texto)
2º/ a la tabla empresas le añadí un campo Tipo (texto), y lo configuré como un cuadro combinado (en la pestaña búsqueda), con tipo de origen en Tabla/Consulta, y este origen: SELECT Criterios.Tipo FROM Criterios GROUP BY Criterios. Tipo ORDER BY Criterios.Tipo;
3º/ Le añadí esos campos a los formularios correspondientes.
4º/ En el subformulario ResultadosEvaluaciones, en el combo Criterio, le quité el origen de la fila, y le programé el siguiente código en el evento al entrar:
Private Sub Criterio_Enter()
Dim miSQL As String
Dim miTipo As String
miTipo = Nz(DLookup("Tipo", "Empresas", "[CIF]='" & Forms!Evaluaciones.Empresa.Value & "'"), "")
If miTipo = "" Then
Me.Criterio.RowSource = ""
Exit Sub
End If
miSQL = "SELECT Criterios.IdCriterio, Criterios.Criterio FROM Criterios " _
& "WHERE (((Criterios.Tipo)='" & miTipo & "')) ORDER BY Criterios.Criterio"
Me.Criterio.RowSource = miSQL
Me.Refresh
End Sub
Con esto ya te filtra el combo de criterios según el tipo de empresa seleccionada en el Formulario Evaluaciones.
En cuanto a la segunda parte, no la entendí muy bien, pero te planteo dos opciones (va la 2ª en la nueva BD: Alt 02)
Opción 1: cambiar el cuadro combinado Criterio por un cuadro de lista (creo que no es lo que buscas...)
opción 2: ocultas el cuadro combinado Criterio, y añades un cuadro de texto con origen de control =Criterio.column(1) , y ponerle al lado un botón de comando que abra una nueva tabla donde se muestren los criterios correspondientes, y al elegir uno, te lo coloque en ResultadoEvaluaciones.
El código para el botón, sería:
Private Sub cmdAñadirCrit_Click()
Dim miTipo As String
Dim miFiltro As String
miTipo = Nz(DLookup("Tipo", "Empresas", "[CIF]='" & Forms!Evaluaciones.Empresa.Value & "'"), "")
miFiltro = "[Tipo]='" & miTipo & "'"
DoCmd.OpenForm "SeleccionCriterio", , , miFiltro, , acDialog
End Sub
El formulario SeleccionCriterio, lo diseñas con distribución tabular, permitir ediciones, agregar y eliminar a No, entrada de datos No, y le añades un botón en el pie de formulario con este código:
Private Sub cmdAceptar_Click()
Dim miCriterio As Integer
miCriterio = Me.IdCriterio.Value
DoCmd.Close acForm, Me.Name
Forms!Evaluaciones.ResultadosEvaluaciones.Form.Criterio.Value = miCriterio
End Sub
Buenas de nuevo,
El primer ejemplo no me funciona según me lo planteas, me da un error, concretamente el "3464, No coinciden los tipos de datos en la expresión de criterios", y me refiere a esto:
miTipo = Nz(DLookup("Tipo", "Empresas", "[Id]='" & Forms!Evaluaciones.IdEmpresas.Value & "'"), "")
Esta fórmula está muy bien, pero no habría otra más sencilla mediante filtros o algo así?. Lo digo porque tengo que hacer la aplicación en inglés, y con tanto baile de nombres en algo meto la pata seguro.
Y respecto a la parte que no entendiste bien, lo que busco es que para el evaluador sea lo más sencillo posible valorar los criterios, y para ello había pensado que al elegir la empresa se mostraran todos los criterios correspondientes a ese tipo de empresa, de esa manera la cosa se hace más fácil para el evaluador al no tener que estar atento de si valora el criterio correcto o no. Y otro paso que había pensado para hacerlo más sencillo es que, o se mostraran en el subformulario todos esos criterios sin tener que ir eligiendo uno a uno de un desplegable para después valorarlo; o que al valorar uno, a continuación te aparezca el siguiente, igual que lo hace tu ejemplo, pero que en vez de la casilla vacía, salga el siguiente criterio.
A lo mejor es mucho lo que pido, si no fuera posible, muchas gracias de todas formas.
El error que te da en : miTipo = Nz(DLookup("Tipo", "Empresas", "[Id]='" & Forms!Evaluaciones.IdEmpresas.Value & "'"), ""), es porque Id me parece que es un número. Si es así, cambia por esto:
miTipo = Nz(DLookup("Tipo", "Empresas", "[Id]=" & Forms!Evaluaciones.IdEmpresas.Value), "").
Si quieres, pásame la BD y la miro, y te comento la posibilidad de usar filtros, y también te programo una cosilla para hacer lo que pides de rellenar los criterios del subformulario, a ver si te sirve.
O ponme la BD en filebig, o mándamela a [email protected]
Buenas Sveinbjorn,
Tal y como me decías en tu última respuesta te envié el archivo a [email protected]
Seguimos en contacto.
Ya te mandé la BD al correo.
Te explico lo que hice:
Lo primero fue borrar los códigos anteriores. Luego, el el origen de la fila de IdCriterios del subformulario le puse: SELECT Criterios. Id, Criterios. Criterio, Criterios. Subcriterio, Criterios. Tipo FROM Criterios ORDER BY Criterios.Criterio;
Es decir, que se listen todos los criterios y subcriterios en el combo.
Añadí un botón llamado cmdEvaluar al formulario Evaluaciones con el siguiente código:
Private Sub cmdEvaluar_Click()
Dim strTipo As String
strTipo = Nz(DLookup("Tipo", "Empresas", "[Id]=" & Me.IdEmpresas.Value), "")
If strTipo = "" Then
MsgBox "Tienes que seleccionar una empresa", vbInformation, "ERROR"
Exit Sub
Else
Call ListaSubCriterios(strTipo)
End If
End Sub
Lo que hace es buscar el tipo de empresa que se va a evaluar, y, o avisa si no se ha seleccionado una empresa, o llama al procedimiento para rellenar todos los subcriterios de ese tipo en el subformulario.
Y por último, he añadido un módulo con el siguiente procedimiento:
Public Sub ListaSubCriterios(Tipo As String)
Dim miSQL As String
Dim vNumSubCriterios As Integer
Dim i As Integer
'----- Listamos los Criterios -----
miSQL = "SELECT Criterios.Id, Criterios.Criterio, Criterios.Subcriterio, Criterios.Tipo " _
& "FROM Criterios WHERE (((Criterios.Tipo)='" & Tipo & "')) ORDER BY Criterios.Id"
Set db = CurrentDb
Set rst = db.OpenRecordset(miSQL, dbOpenSnapshot)
rst.MoveLast
vNumSubCriterios = rst.RecordCount
If vNumSubCriterios = 0 Then Exit Sub
rst.MoveFirst
For i = 1 To vNumSubCriterios
Forms!Evaluaciones.ResultadosEvaluaciones.Form.AllowAdditions = True
Forms!Evaluaciones.ResultadosEvaluaciones.SetFocus
DoCmd.GoToRecord , , acNewRec
Forms!Evaluaciones.ResultadosEvaluaciones.Form.IdCriterios = rst(0).Value
rst.MoveNext
Next
Forms!Evaluaciones.ResultadosEvaluaciones.Form.AllowAdditions = False
Forms!Evaluaciones.Refresh
End Sub
Este procedimiento es el que se encarga de rellenar automáticamente todos los subcriterios en el subformulario. Al subformulario ResultadosEvaluaciones le cambié las siguinetes propiedades: Permitir Agregar a No, Permitir Eliminar a No, y IdCriterios lo puse Oculto, y añadí un cuadro de texto nuevo que nos recoge la columna 2 (que corresponde al subcriterio) del combo IdCriterios. Este cuadro de texto está bloqueado para que no se pueda editar y no es un punto de tabulación.
Ya me dirás si es lo que estabas buscando, que creo que sí.
