Problemas de subformulario
Tengo un pequeño problema. Tengo un formulario en el cual dispongo de varios campos de selección.
Cuando se realiza la selección, creo una consulta tomando los valores introducidos y utilizando VBA creo la consulta en cuestión. El problema viene cuando intento abrir el subformulario y refrescar los valores, no lo hace. Te adjunto el código por si ves algún problemilla.
Gracias de antemano.
Private Sub consultar_Click()
Dim txt1 As String, txt2 As String, txt3 As String, txt4 As String, y As Boolean
Dim ctlLista As Control
inicio_proceso:
On Error GoTo err_consultar
If (denominacion.Value <> Null) Or (denominacion.Value <> "") Then
txt1 = " ((piezas.denominacion) like '*" & denominacion.Value & "*')"
End If
If Not IsNull(numset.Value) Then
txt2 = " ((Piezas.set)='" & numset.Value & "')"
End If
If Not IsNull(clave.Value) Then
txt3 = " ((piezas.clave)='" & clave.Value & "')"
End If
If Not IsNull(modulo.Value) Then
txt4 = " ((Modulos_set.modulo)=" & modulo.Value & ")"
End If
'strSQL = "SELECT Piezas.clave, Piezas.denominacion, Piezas.set, Modulos_set.descri_set, Modulos_set.modulo" & _
" FROM Piezas INNER JOIN Modulos_set ON Piezas.set = Modulos_set.set"
strSQL = "SELECT Piezas.clave, Piezas.denominacion, Piezas.set, Modulos_set.descri_set, Modulos.modulo" & _
" FROM (Piezas INNER JOIN Modulos_set ON Piezas.set = Modulos_set.set) INNER JOIN Modulos ON Modulos_set.modulo = Modulos.idmodulo"
If (txt1 <> "") Or (txt2 <> "") Or (txt3 <> "") Or (txt4 <> "") Then
strSQL = strSQL & " Where "
If txt1 <> "" Then
strSQL = strSQL & txt1
y = True
End If
If txt2 <> "" Then
If y = True Then
strSQL = strSQL & " and " & txt2
Else
strSQL = strSQL & txt2
y = True
End If
End If
If txt3 <> "" Then
If y = True Then
strSQL = strSQL & " and " & txt3
Else
strSQL = strSQL & txt3
y = True
End If
End If
If txt4 <> "" Then
If y = True Then
strSQL = strSQL & " and " & txt4
Else
strSQL = strSQL & txt4
y = True
End If
End If
End If
strSQL = strSQL & ";"
crea_consulta:
' Set dbs = CurrentDb
' Set qdfLocal = dbs.CreateQueryDef("Consulta", strSQL)
' Set rstqry = qdfLocal.OpenRecordset()
' rstqry.Close
'rstqry.Requery
'Me.Subfrm.Visible = True
'Me.Subfrm.SourceObject = "subfrm_consulta"'
'Me.Subfrm.Form.Requery
'Me.Subfrm.Form.Recalc
'Set ctlLista = Forms!Frm_problemas!Subfrm
'ctlLista.Requery
'ctlLista.Form.Recalc
' With rstqry
' If .RecordCount = 0 Then
' MsgBox "no existen registros para la selección", vbCritical, "Aviso"
' Exit Sub
' Else
' .MoveLast
' numreg.Value = rstqry.RecordCount
' .MoveFirst
' End If
' End With
'rstqry.Close
'Me.Subfrm.Form.RecordSource = strSQL
Me.Subfrm.Requery
Me.Subfrm.Form.Recalc
Me.Subfrm.Form.Refresh
'Me.Subfrm.SourceObject = "subfrm_consulta"
Me.Subfrm.Visible = True
Exit Sub
err_consultar:
If err.Number = 3012 Then
DoCmd.DeleteObject acQuery, "Consulta"
GoTo crea_consulta
Else
Control_error
End If
End Sub
Cuando se realiza la selección, creo una consulta tomando los valores introducidos y utilizando VBA creo la consulta en cuestión. El problema viene cuando intento abrir el subformulario y refrescar los valores, no lo hace. Te adjunto el código por si ves algún problemilla.
Gracias de antemano.
Private Sub consultar_Click()
Dim txt1 As String, txt2 As String, txt3 As String, txt4 As String, y As Boolean
Dim ctlLista As Control
inicio_proceso:
On Error GoTo err_consultar
If (denominacion.Value <> Null) Or (denominacion.Value <> "") Then
txt1 = " ((piezas.denominacion) like '*" & denominacion.Value & "*')"
End If
If Not IsNull(numset.Value) Then
txt2 = " ((Piezas.set)='" & numset.Value & "')"
End If
If Not IsNull(clave.Value) Then
txt3 = " ((piezas.clave)='" & clave.Value & "')"
End If
If Not IsNull(modulo.Value) Then
txt4 = " ((Modulos_set.modulo)=" & modulo.Value & ")"
End If
'strSQL = "SELECT Piezas.clave, Piezas.denominacion, Piezas.set, Modulos_set.descri_set, Modulos_set.modulo" & _
" FROM Piezas INNER JOIN Modulos_set ON Piezas.set = Modulos_set.set"
strSQL = "SELECT Piezas.clave, Piezas.denominacion, Piezas.set, Modulos_set.descri_set, Modulos.modulo" & _
" FROM (Piezas INNER JOIN Modulos_set ON Piezas.set = Modulos_set.set) INNER JOIN Modulos ON Modulos_set.modulo = Modulos.idmodulo"
If (txt1 <> "") Or (txt2 <> "") Or (txt3 <> "") Or (txt4 <> "") Then
strSQL = strSQL & " Where "
If txt1 <> "" Then
strSQL = strSQL & txt1
y = True
End If
If txt2 <> "" Then
If y = True Then
strSQL = strSQL & " and " & txt2
Else
strSQL = strSQL & txt2
y = True
End If
End If
If txt3 <> "" Then
If y = True Then
strSQL = strSQL & " and " & txt3
Else
strSQL = strSQL & txt3
y = True
End If
End If
If txt4 <> "" Then
If y = True Then
strSQL = strSQL & " and " & txt4
Else
strSQL = strSQL & txt4
y = True
End If
End If
End If
strSQL = strSQL & ";"
crea_consulta:
' Set dbs = CurrentDb
' Set qdfLocal = dbs.CreateQueryDef("Consulta", strSQL)
' Set rstqry = qdfLocal.OpenRecordset()
' rstqry.Close
'rstqry.Requery
'Me.Subfrm.Visible = True
'Me.Subfrm.SourceObject = "subfrm_consulta"'
'Me.Subfrm.Form.Requery
'Me.Subfrm.Form.Recalc
'Set ctlLista = Forms!Frm_problemas!Subfrm
'ctlLista.Requery
'ctlLista.Form.Recalc
' With rstqry
' If .RecordCount = 0 Then
' MsgBox "no existen registros para la selección", vbCritical, "Aviso"
' Exit Sub
' Else
' .MoveLast
' numreg.Value = rstqry.RecordCount
' .MoveFirst
' End If
' End With
'rstqry.Close
'Me.Subfrm.Form.RecordSource = strSQL
Me.Subfrm.Requery
Me.Subfrm.Form.Recalc
Me.Subfrm.Form.Refresh
'Me.Subfrm.SourceObject = "subfrm_consulta"
Me.Subfrm.Visible = True
Exit Sub
err_consultar:
If err.Number = 3012 Then
DoCmd.DeleteObject acQuery, "Consulta"
GoTo crea_consulta
Else
Control_error
End If
End Sub
1 Respuesta
Respuesta de sofocles
1
A priori observo que tu sistema esta muy bien montado, no me he detenido para ver si existe algún error en el código, no obstante, puedes intentar cambiar un poco la forma de alimentar el subformulario, y hacerlo directamente con la consulta, sin guardar esta en la base de datos, a no ser que la utilices después en otros procesos que dependan del principal.
Lo único que debes añadir, es que en el evento después de actualizar de cada cuadro de texto (Afterupdate), debes hacer la llamada a la función que crea la consulta, y alimentar el subformulario con esta de la siguiente forma:
Sub CuadrodeTexto1_AfterUpdate()
Dim sql as string
sql=Crear_Consulta() -> crea la cadena sql mas o menos como el proceso de consultar_Click().
'*** Setear el subformulario
Set f=Forms![NombreformularioPrincipal]
set sf=f![NombreSubformulario].form
'*** Mandar la sentencia como origen de datos
sf.recordsource=sql
End Sub
Creo que simplificas bastante el código, y cada vez que actualices un cuadro de texto, se montará la consulta que alimenta el subformulario sin guardarla.
Lo único que debes añadir, es que en el evento después de actualizar de cada cuadro de texto (Afterupdate), debes hacer la llamada a la función que crea la consulta, y alimentar el subformulario con esta de la siguiente forma:
Sub CuadrodeTexto1_AfterUpdate()
Dim sql as string
sql=Crear_Consulta() -> crea la cadena sql mas o menos como el proceso de consultar_Click().
'*** Setear el subformulario
Set f=Forms![NombreformularioPrincipal]
set sf=f![NombreSubformulario].form
'*** Mandar la sentencia como origen de datos
sf.recordsource=sql
End Sub
Creo que simplificas bastante el código, y cada vez que actualices un cuadro de texto, se montará la consulta que alimenta el subformulario sin guardarla.
Muchas Gracias por tu respuesta. Lo intento inmediatamente y si no sale te volveré a pedir ayuda. Por el momento creo que es otro punto de vista muy interesante. Gracias.
