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
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
