¿Puedo mostrar un subformulario diferente según el valor de un campo para un registro access?
Necesito mostrar un subformulario diferente, según el valor de un campo que llamo "Hecho Extraordinario". Si el hecho es un accidente de transito quiero captar los nombre de los heridos, fallecidos, etc. Si el hecho es un robo de ganado poder captar tipo de ganado, cantidad robada (sacrificada)
Nada impide tener ambos subformularios abiertos y ocupando el mismo espacio.
Access provee herramientas para ponerlos en primer o segundo plano, también esta la opción de hacerlos visibles/invisibles (incluso minimizarlos).
Cualquiera de ellas puede actuar en función de un valor externo (normalmente en el formulario principal), dado que ambos subformularios son simples objetos para el formulario principal.
Si estas interesado en cualquiera de esas posibilidades coméntalo.
Buenos días. Muchas gracias por responderme. Si, me gustaría profundizar en la variante de mostrar uno u otro subformulario. Realmente pueden ser varios, más de 3, pero lo que sirve para 2, sirve para más cantidad
Un formulario puede tener multiples subformularios, tanto dependientes como independientes y todos ellos serán tratados como objetos del formulario.
No recuerdo el comando para ponerlos en primer/segundo plano, pero siempre ha funcionado la opción de hacerlos visibles/invisibles a voluntad del programador.
Si un formulario esta en modo invisible no podrá obtener el foco, pero aun así se podrá acceder a todo su contenido (con las ventajas que ello conlleva).
El método aconsejable para evitar problemas consiste en evaluar su condición en una sola instrucción (solo uno visible, el resto: invisibles) y aconsejable que se superpongan bien, esto es igualar su posición (propiedades TOP y LEFT) así como su tamaño (propiedades HEIGHT y WIHDTH) ello evitara algún parpadeo al redibujarse el formulario principal.
Un formulario con dos subformularios (SubForm_A, SubForm_B)
Le añadimos tres botones:
.- Uno hace visible a SubForm_A
.- Otro hace visible a SubForm_B
.- El tercero los intercambia
Añadimos un combo para permitir mas opciones, tiene dos columnas.
.- La primera (columna cero) es la descripción (texto libre)
.-La segunda (columna 1 y oculta) el elemento que corresponde con la descripción
Añadimos en el evento LOAD del formulario el inicio del combo seleccionando su primer valor (se puede sustituir por un valor cualquiera de los disponibles en el combo) y ejecutamos su evento.
A continuación el código utilizado y una nota: se puede utilizar cualquier formula que como resultado un True/False o la alternativa de un cero (False) o diferente de cero (True).
Option Compare Database Option Explicit Private Sub Btn_A_Click() Me.SubForm_A.Visible = True Me.SubForm_B.Visible = False End Sub Private Sub Btn_B_Click() Me.SubForm_A.Visible = False Me.SubForm_B.Visible = True End Sub Private Sub Btn_AB_Click() Me.SubForm_A.Visible = Not Me.SubForm_A.Visible Me.SubForm_B.Visible = Not Me.SubForm_B.Visible End Sub Private Sub Cbo_Selector_Click() Me.SubForm_A.Visible = Me.SubForm_A.Name = Me.Cbo_Selector.Column(1) Me.SubForm_B.Visible = Me.SubForm_B.Name = Me.Cbo_Selector.Column(1) End Sub Private Sub Form_Load() Me.Cbo_Selector = Me.Cbo_Selector.ItemData(0) Cbo_Selector_Click End Sub
1 respuesta más de otro experto
Le recomiendo utilizar formularios independientes y con base en ID pasado como argumento se diligencie la información. Por ejemplo, el evento Después de actualizar algo como.
Private Sub Hecho_Extraordinario_AfterUpdate() Dim strFormulario As String Dim strCondicion As String ' 1. Determina qué formulario abrir y crea la condición de filtro (WHERE clause) Select Case Me.Hecho_Extraordinario.Value Case "Accidente de Transito" strFormulario = "Form_AccidenteTransito" ' El ID del registro principal es el filtro para el formulario de detalle strCondicion = "[ID_Hecho_FK] = " & Me!ID_Hecho ' Asume que el campo clave es ID_Hecho Case "Robo de Ganado" strFormulario = "Form_RoboGanado" strCondicion = "[ID_Hecho_FK] = " & Me!ID_Hecho ' Asume que el campo clave es ID_Hecho Case Else Exit Sub ' Si el valor no coincide con nada, no hace nada End Select ' 2. Cierra cualquier formulario de detalle que esté abierto para este hecho (opcional, pero recomendado) ' Puedes usar On Error Resume Next aquí si no estás seguro de que estén abiertos ' Si usas DoCmd.Close, usa el nombre del formulario. ' 3. Abre el formulario condicionalmente If strFormulario <> "" Then DoCmd.OpenForm FormName:=strFormulario, _ View:=acNormal, _ WhereCondition:=strCondicion, _ DataMode:=acEdit ' O acAdd para un nuevo registro de detalle, si es necesario End If End Sub
Esto es una idea
¡Gracias! Muchísimas gracias, es una variante interesante. Tratare de implementar y después le cuento
Guillermo olvídese de incrustar varios subformularios y saturarse de botones, no es lo idóneo porque cada vez que tenga un nuevo "HECHO EXTRAORDINARIO" además de crear el subformulario tiene que editar el código en el formulario principal. Le propongo 2 soluciones.
1. Mediante un módulo de clase. (Forma profesional)
Cuando se requiera de un nuevo hecho se crea el subformulario para la respectiva tabla y se adiciona en la colección de la clase. Requiere conocimientos avanzados de VBA. Con esto puede manejar muchos "HECHOS."
2. Con un formulario de pestaña (No es lo más profesional), pero si más practico que mostrar y ocultar subformularios. No requiere conocimientos avanzados de VBA.
Le muestro de forma rápida cómo sería el código de la clase.
' ClsManejadorSubForm Option Compare Database Option Explicit Private m_frmPrincipal As Access.Form Private m_ctlSubForm As Access.Control Private m_colSubFormularios As Collection ' Inicializa la clase con el formulario principal y el control de subformulario. Public Sub Init(frm As Access.Form, ctlSubForm As Access.Control) Set m_frmPrincipal = frm Set m_ctlSubForm = ctlSubForm Set m_colSubFormularios = New Collection ' Mapeo de TipoHecho (Clave de Colección) a Nombre de Formulario (Ítem) '? ¡Importante! Las claves deben ser el texto exacto del campo TipoHecho. m_colSubFormularios. Add "frmSubAccidentes", "Accidente de Tránsito" m_colSubFormularios. Add "frmSubRobos", "Robo de Ganado" m_colSubFormularios. Add "frmSubIncendios", "Incendio" m_colSubFormularios. Add "frmSubHurtos", "Hurto a Vivienda" ' Agrega aquí nuevos mapeos (Ej: m_colSubFormularios. Add "frmSubNuevo", "Nuevo Hecho") End Sub ' Método principal para cambiar el subformulario basándose en el TipoHecho. Public Sub CambiarSubformulario(ByVal strTipoHecho As String) Dim strNombreSubForm As String On Error GoTo Error_Handler ' 1. Obtener el nombre del formulario asociado al TipoHecho ' Se usa Item(strTipoHecho) para obtener el nombre del formulario usando el texto del TipoHecho como clave. strNombreSubForm = m_colSubFormularios.Item(strTipoHecho) ' 2. Asignar el SourceObject (Obligatorio antes de la vinculación) m_ctlSubForm.SourceObject = strNombreSubForm ' 3. Permitir que Access cargue el SourceObject (Mitiga el error "Valor no válido") DoEvents ' 4. Establecer la vinculación (Campos principales y secundarios) m_ctlSubForm.LinkMasterFields = "IdHecho" m_ctlSubForm.LinkChildFields = "IdHecho" Exit Sub Error_Handler: ' Error 5: Subíndice fuera del intervalo (o clave no encontrada). ' Esto ocurre si el TipoHecho no tiene un subformulario mapeado en la colección. If Err.Number = 5 Then ' Vacía el control de subformulario si no hay un mapeo m_ctlSubForm.SourceObject = "" m_ctlSubForm.LinkMasterFields = "" m_ctlSubForm.LinkChildFields = "" Resume Next ' Continúa la ejecución sin detener el programa ElseIf Err.Number = 2485 Then ' Error 2485: El nombre del formulario no existe. ' Esto ocurre si el nombre del formulario hijo es incorrecto. MsgBox "Error en la clase: El subformulario '" & strNombreSubForm & "' no existe. Revise el nombre en clsManejadorSubForm.", vbCritical Else ' Otros errores (ej: si IdHecho no existe en el origen del subformulario) MsgBox "Error " & Err.Number & " en CambiarSubformulario: " & Err.Description, vbCritical End If End Sub ' Limpieza de objetos al descargar la clase Private Sub Class_Terminate() Set m_frmPrincipal = Nothing Set m_ctlSubForm = Nothing Set m_colSubFormularios = Nothing End Sub
Observe cómo se adiciona un subformulario en la clase de la colección procedimiento Public Sub Init()
Cómo no es posible documentar los 2 ejemplos en el foro, puede solicitarlos a [email protected]. Favor en el asunto anotar la pregunta.
Corrijo el correo es [email protected]
Observe como es el formulario principal para registrar los hechos.
Y el diseño:
Las personas del foro que estén interesadas en este ejemplo pueden solicitarlo a [email protected] en el asunto anotar "Estoy interesado en el ejemplo de la clase".
Complemento este uso de la clase para simular un menú de opciones mediante un cuadro de lista.
Código del formulario.
Option Compare Database Option Explicit Private objManejador As clsManejadorSubForm Sub mostrar_sub() On Error GoTo Err_Handler DoCmd.SearchForRecord , "", acFirst, "[IdHecho] = " & Str(Nz(Screen.ActiveControl, 0)) objManejador.CambiarSubformulario Me.TipoHecho.Value Me.ctlSubFormulario.Visible = True Me.ctlSubFormulario.SetFocus Exit Sub Err_Handler: MsgBox "Error en mostrar_sub: " & Err.Description, vbExclamation End Sub Private Sub btnMostar_Click() Me.ctlSubFormulario.Visible = True End Sub Private Sub btnOcultar_Click() If Me.lstHechos.ItemsSelected.Count > 0 Then Me.ctlSubFormulario.Visible = False Me.lblSaludo.Caption = "Ha ocultado el subformulario " & Me.lstHechos.Column(1) Me.lblSaludo.Visible = True End If End Sub Private Sub Form_Load() Set objManejador = New clsManejadorSubForm objManejador.Init Me, Me.ctlSubFormulario, True ' True = modo depuración End Sub Private Sub Form_Unload(Cancel As Integer) Set objManejador = Nothing End Sub Private Sub lstHechos_Click() Me.lblSaludo.Visible = False ' Opcional Call mostrar_sub End Sub
Gracias a la clase con el mínimo de código podemos manejar cualquier cantidad de subformularios dentro de un formulario principal. Estos ejemplos solo aplican a formularios vinculados a datos, para formularios desvinculados es más complejo.
He cambiado el código de la clase porque reemplacé la colección por una tabla donde se van ingresando los hechos y el nombre del subformulario, con esto no es necesario editar el código VBA por nuevos hechos.
Código de clase
' ========================================================== ' clsManejadorSubForm (Con animación) ' ---------------------------------------------------------- '4. Muestra dinámicamente el subformulario correspondiente ' según el TipoHecho del formulario principal. ' Usa el campo [NombreFormulario] de tblHechos. ' Incluye animación de transición con efecto de borde. ' ========================================================== Private m_frmPrincipal As Access.Form Private m_ctlSubForm As Access.Control Private m_Debug As Boolean ' ========================================================== ' Inicialización ' ========================================================== Public Sub Init(frm As Access.Form, ctlSubForm As Access.Control, Optional ByVal DebugMode As Boolean = False) Set m_frmPrincipal = frm Set m_ctlSubForm = ctlSubForm m_Debug = DebugMode End Sub ' ========================================================== ' Cambia el subformulario según TipoHecho de tblHechos ' ========================================================== Public Sub CambiarSubformulario(ByVal strTipoHecho As String) Dim db As DAO.Database Dim rs As DAO.Recordset Dim strNombreSubForm As String Dim frmExiste As Boolean Dim obj As AccessObject Dim i As Long On Error GoTo Error_Handler If m_ctlSubForm Is Nothing Then Exit Sub If Len(Nz(strTipoHecho, "")) = 0 Then Exit Sub Set db = CurrentDb() ' Buscar el formulario asociado al TipoHecho Set rs = db.OpenRecordset( _ "SELECT NombreFormulario FROM tblHechos WHERE TipoHecho = '" & Replace(strTipoHecho, "'", "''") & "'", _ dbOpenSnapshot) If rs.EOF Then If m_Debug Then Debug.Print "TipoHecho no encontrado: " & strTipoHecho m_ctlSubForm.SourceObject = "" rs.Close Set rs = Nothing Set db = Nothing Exit Sub End If strNombreSubForm = Nz(rs!NombreFormulario, "") rs.Close Set rs = Nothing Set db = Nothing If Len(strNombreSubForm) = 0 Then If m_Debug Then Debug.Print "El campo NombreFormulario está vacío para: " & strTipoHecho m_ctlSubForm.SourceObject = "" Exit Sub End If ' Verificar si el formulario existe realmente frmExiste = False For Each obj In CurrentProject.AllForms If StrComp(obj.Name, strNombreSubForm, vbTextCompare) = 0 Then frmExiste = True Exit For End If Next obj If Not frmExiste Then MsgBox "?? El subformulario '" & strNombreSubForm & _ "' configurado en tblHechos no existe.", vbExclamation m_ctlSubForm.SourceObject = "" Exit Sub End If ' Cargar el subformulario m_ctlSubForm.SourceObject = strNombreSubForm DoEvents m_ctlSubForm.LinkMasterFields = "IdHecho" m_ctlSubForm.LinkChildFields = "IdHecho" DoEvents ' Ir a nuevo registro For i = 1 To 100 On Error Resume Next If Not m_ctlSubForm.Form Is Nothing Then m_ctlSubForm.Form.Recordset.AddNew Exit For End If DoEvents Next i ' ?? Animación visual mejorada AnimarTransicion Exit Sub Error_Handler: MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "CambiarSubformulario" End Sub ' ========================================================== ' Efecto visual: transición + borde resaltado ' ========================================================== Private Sub AnimarTransicion(Optional ByVal ColorInicio As Long = vbWhite, Optional ByVal ColorDestacado As Long = -1) On Error Resume Next Dim frmSub As Access.Form Dim i As Integer Dim colOriginalBorde As Long Dim grosorOriginal As Integer ' Asignar color si no se pasó (RGB no puede estar como predeterminado) If ColorDestacado = -1 Then ColorDestacado = RGB(135, 206, 250) ' Azul cielo brillante If m_ctlSubForm Is Nothing Then Exit Sub If m_ctlSubForm.Form Is Nothing Then Exit Sub Set frmSub = m_ctlSubForm.Form ' Guardar configuración original del borde colOriginalBorde = m_ctlSubForm.BorderColor grosorOriginal = m_ctlSubForm.BorderWidth ' 1?? — Efecto de fondo: brillo progresivo For i = 0 To 100 Step 5 frmSub.Section(acDetail).BackColor = MezclarColor(ColorInicio, ColorDestacado, i / 100) DoEvents Next i ' 2?? — Mantener el color brillante Dim t As Single t = Timer Do While Timer < t + 0.2 DoEvents Loop ' 3?? — Efecto de borde parpadeante (resaltado moderno) m_ctlSubForm.BorderColor = RGB(30, 144, 255) ' Azul brillante (Dodger Blue) m_ctlSubForm.BorderWidth = 3 For i = 1 To 2 m_ctlSubForm.BorderColor = RGB(0, 191, 255) DoEvents Esperar 0.07 m_ctlSubForm.BorderColor = RGB(30, 144, 255) DoEvents Esperar 0.07 Next i ' 4?? — Desvanecimiento del fondo For i = 100 To 0 Step -4 frmSub.Section(acDetail).BackColor = MezclarColor(ColorInicio, ColorDestacado, i / 100) DoEvents Next i ' 5?? — Restaurar borde original Esperar 0.05 m_ctlSubForm.BorderColor = colOriginalBorde m_ctlSubForm.BorderWidth = grosorOriginal End Sub ' ========================================================== ' Función auxiliar para mezclar colores ' ========================================================== Private Function MezclarColor(ByVal c1 As Long, ByVal c2 As Long, ByVal t As Double) As Long Dim r1 As Long, g1 As Long, b1 As Long Dim r2 As Long, g2 As Long, b2 As Long Dim r As Long, g As Long, b As Long r1 = c1 Mod 256: g1 = (c1 \ 256) Mod 256: b1 = (c1 \ 65536) Mod 256 r2 = c2 Mod 256: g2 = (c2 \ 256) Mod 256: b2 = (c2 \ 65536) Mod 256 r = r1 + (r2 - r1) * t g = g1 + (g2 - g1) * t b = b1 + (b2 - b1) * t MezclarColor = RGB(r, g, b) End Function ' ========================================================== ' Pausa breve (simula Sleep sin bloquear Access) ' ========================================================== Private Sub Esperar(ByVal Segundos As Double) Dim t As Single t = Timer Do While Timer < t + Segundos DoEvents Loop End Sub ' ========================================================== ' Limpieza ' ========================================================== Private Sub Class_Terminate() Set m_frmPrincipal = Nothing Set m_ctlSubForm = Nothing End Sub
He agregado una transición a los bordes de los subformularios, mediante el método AnimarTransicion, no obstante, se puede comentar si no quiere la transición. Solicite los ejemplos a [email protected]. Con esto doy por concluida mi respuesta a esta pregunta.