Autor Tema: Creación de formulario por código  (Leído 420 veces)

Desconectado xavi

  • Administrador
  • Habitual
  • *****
  • Mensajes: 184
Creación de formulario por código
« en: Abril 20, 2012, 07:15:36 pm »
Palabras clave: creación, formulario, código
Autor: Eduardo Olaz
Extraído de: La web del Búho

Pregunta

En anteriores intervenciones he dicho cosas como:

1.- No se pueden crear controles en tiempo de ejecución
2.- No se pueden crear matrices de controles

Pues, de alguna manera, no es cierto

Asignar al Click de un botón el procedimiento CrearFormulario

Código: [Seleccionar]
Option Explicit

Sub CrearFormulario()
' **************
' Código de prueba
' eduardo@olaz.net
' Junio de 2002
' **************

    Dim frm As Form
    Dim strFormulario As String
    Const conFilas As Long = 16
    Const conColumnas As Long = 16
    Const conAncho As Long = 400
    Const conAlto As Long = 400
    Const conSeparacion As Long = 50
    Const conMargenX As Long = 40
    Const conMargenY As Long = 40
    Const conComilla As String = """"
    Const conIncrementoColor As Long = 65536
    Dim lngFila As Long
    Dim lngColumna As Long
    Dim lngX As Long
    Dim lngY As Long
    Dim ctlEtiqueta As Control
    Dim ctlLabel As Control, ctlText As Control
    Dim ctlBoton As Control
    Dim intDataX As Integer, intDataY As Integer
    Dim intLabelX As Integer, intLabelY As Integer
    Dim colColor As Long
    Dim aControles() As Control
    Dim strCodigoBotonSalir As String
    Dim mdlFormulario As Module

    ReDim aControles(conColumnas, conFilas)
    ' Crea el nuevo formulario
    Set frm = CreateForm
    colColor = 0 * conIncrementoColor \ 16
    With frm
        .RecordSelectors = False
        .NavigationButtons = False
        .Width = 7300
        .ScrollBars = 0
        .DividingLines = False
        .MinMaxButtons = 0
    End With

    For lngFila = 0 To conFilas - 1
        lngY = lngY + conAncho + conSeparacion
        For lngColumna = 0 To conColumnas - 1
           lngX = lngX + conAlto + conSeparacion
           Set aControles(lngColumna, lngFila) = CreateControl(frm.Name, acLabel, , "", "", _
            lngX, lngY, conAncho, conAlto)
            Set ctlEtiqueta = aControles(lngColumna, lngFila)
            With ctlEtiqueta
                .BackColor = colColor
                .BackStyle = 1
            End With
            colColor = colColor + conIncrementoColor
        Next lngColumna

        lngX = 0
    Next lngFila

        Set ctlBoton = CreateControl(frm.Name, acCommandButton, , "", "", 8000, 8000, 1500, 500)
        ctlBoton.Caption = "Salir"
        ctlBoton.Name = "cmdSalir"

    Set mdlFormulario = frm.Module
    strCodigoBotonSalir = "Private sub " & ctlBoton.Name & "_Click()" & _
                        vbCrLf & _
                        vbCrLf & _
                        "msgbox " & conComilla & "Cierro el formulario" & conComilla & _
                        " & me.name " & _
                        vbCrLf & _
                        "    docmd.Close" & _
                        vbCrLf & _
                        "End Sub"
    With mdlFormulario
        .InsertText strCodigoBotonSalir
    End With
    ' Restaura el formulario.
    DoCmd.Restore
    Erase aControles
    Set ctlEtiqueta = Nothing
    strFormulario = frm.Name
    DoCmd.Save acForm, strFormulario
    DoCmd.OpenForm strFormulario

    Debug.Print Forms(strFormulario).Width
    Set frm = Nothing
End Sub

¿Os ha gustado...?

Saludos:

Eduardo