Guardar propiedades de controles en formulario VBA |
Responder |
Autor | |
lunasoft
Ver perfil usuario
Enviar mensaje privado
Ver los mensajes del usuario
Visite la página de los usuarios
Añadir a la lista de amigos
Habitual Unido: 04/Noviembre/2014 Localización: Graz Estado: Sin conexión Puntos: 100 |
Tema: Guardar propiedades de controles en formulario VBA Enviado: 17/Julio/2021 a las 23:46 |
Hola a todos.
Estoy editando el formato de mis formularios a través de una función VBA que cargo en el OnLoad de cada formulario poara darle homegeneidad a los p[royectos, y en el caso de querer cambiar algo, pues con hacerlo en la función, se haría para todo el proyecto. El código es el siguiente:
-----
Public Sub fncCabeceraFormulario(miForm As Form)
On Error GoTo fncCabeceraFormulario_Error
'maquetacion de cabecera
With miForm
.Section(0).BackColor = LN_BLANCO
.Section(1).BackColor = LN_GRIS_CLARO
.Section(2).BackColor = LN_BLANCO
End With
If ControlExists("lblTitel", miForm) Then
With miForm.lblTitel 'Item 1
.Left = 128
.Top = 128
.Height = 550 '509
.ForeColor = LN_ROJO_ACCESS
.FontName = "Calibri"
.FontSize = 22
End With
End If
If ControlExists("lnTitel", miForm) Then
With miForm.lnTitel 'Item 10
.Left = miForm.lblTitel.Left
.Top = miForm.lblTitel.Top + miForm.lblTitel.Height + 32
.Width = 10500
.Height = 0
.BorderColor = LN_ROJO_ACCESS
End With
End If
If ControlExists("btnExit", miForm) Then
With miForm.btnExit 'Item 7
.Left = miForm.lnTitel.Left + miForm.lnTitel.Width - .Width
.Top = miForm.lblTitel.Top
.Height = miForm.lblTitel.Height
.Width = .Height
End With
End If
If ControlExists("btnNew", miForm) Then
With miForm.btnNew
.Left = miForm.btnExit.Left - .Width
.Top = miForm.btnExit.Top
.Height = miForm.btnExit.Height
.Width = .Height
End With
End If
On Error GoTo 0
Exit Sub
fncCabeceraFormulario_Error:
' MsgBox "Error " & err.Number & " (" & err.Description & ") in procedure fncCabeceraFormulario, line " & Erl & "."
TSCs_ReportUnexpectedError "fncCabeceraFormulario", miForm.Name, "Error al formatear la cabecera"
End Sub
-----
Las preguntas son:
1.
existe algún modo de guardar esos cambios en el formulario para que al abrirlo en modo diseño se muestren los cambios?
2.
estoy llamando los colores por su numero (p.ej.LN_BLANCO = 16777215)
hay un modo mejor de hacerlo (constantes de access o algo así)
Gracias a todos
|
|
Juanjo Luna (Lunasoft)
Microsoft MVP 2023 ---------------- https://www.luna-soft.es/ https://www.youtube.com/ACCESSoTOTAL https://github.com/ACCESSoTOTAL |
|
xavi
Ver perfil usuario
Enviar mensaje privado
Ver los mensajes del usuario
Visite la página de los usuarios
Añadir a la lista de amigos
Administrador Terrassa-BCN Unido: 10/Mayo/2005 Localización: Catalunya |||| Estado: Sin conexión Puntos: 14746 |
Enviado: 17/Julio/2021 a las 23:46 |
1. En mi experiencia, lo mejor es realizar la carga de todos esos parametros/valores en el Load. Así puedes jugar con distintos "skins" que, en lugar de cargarse por constantes, se carguen por parametros.
2. Algunos colores si que existen en como constante (vbWhite, vbBlack, vbRed, etc).
Yo utilizo una Enumeración:
Public Enum eColores
' Iguales a constantes
Black = vbBlack
Blue = vbBlue
Cyan = vbCyan
Green = vbGreen
Magenta = vbMagenta
Red = vbRed
White = vbWhite
Yellow = vbYellow
' Resto/personalizados
' Azules
Blue_Intense = 6108695 ' #17365D
Blue_Medium = 14602694 ' #C6D1DE
Blue_Light = 10319446 ' #56769D
Blue_Back = 5849905 ' #314359
' Grises
Grey = 12632256
GreyForeColor = 10855845
GreyLight = 8355711
' Naranja
Orange_Intense = 113147 ' #FBB901
Orange_Medium = 9692671 ' #FFE593
Orange_Light = 6083838 ' #FED45C
Orange_Back = 3459582 ' #FEC934
End Enum
Pero ya sabes que (y nunca mejor dicho) para gustos los colores.
Un saludo
|
|
lunasoft
Ver perfil usuario
Enviar mensaje privado
Ver los mensajes del usuario
Visite la página de los usuarios
Añadir a la lista de amigos
Habitual Unido: 04/Noviembre/2014 Localización: Graz Estado: Sin conexión Puntos: 100 |
Enviado: 17/Julio/2021 a las 23:47 |
Gracias Xavi.
El problema con el que me encuentro es que al hacerlo desde el Load, hay retardo por lo que se muestra primero con el formato previo y luego se carga el formato del load.
De ahí la pregunta de si se pueden guardar los cambios; para evitar el bailoteo de los controles y para poder visualizar posteriormente en la vista diseño el formato final.
|
|
Juanjo Luna (Lunasoft)
Microsoft MVP 2023 ---------------- https://www.luna-soft.es/ https://www.youtube.com/ACCESSoTOTAL https://github.com/ACCESSoTOTAL |
|
xavi
Ver perfil usuario
Enviar mensaje privado
Ver los mensajes del usuario
Visite la página de los usuarios
Añadir a la lista de amigos
Administrador Terrassa-BCN Unido: 10/Mayo/2005 Localización: Catalunya |||| Estado: Sin conexión Puntos: 14746 |
Enviado: 17/Julio/2021 a las 23:47 |
En mi caso, y dado que reposiciono y redimensiono, yo utilizo el evento Resize en lugar del Load.
|
|
lunasoft
Ver perfil usuario
Enviar mensaje privado
Ver los mensajes del usuario
Visite la página de los usuarios
Añadir a la lista de amigos
Habitual Unido: 04/Noviembre/2014 Localización: Graz Estado: Sin conexión Puntos: 100 |
Enviado: 17/Julio/2021 a las 23:47 |
Muchas gracias.
|
|
Juanjo Luna (Lunasoft)
Microsoft MVP 2023 ---------------- https://www.luna-soft.es/ https://www.youtube.com/ACCESSoTOTAL https://github.com/ACCESSoTOTAL |
|
Maverick2019
Habitual Unido: 10/Junio/2019 Localización: Madrid Estado: Sin conexión Puntos: 145 |
Enviado: 17/Julio/2021 a las 23:47 |
Con la venia, quizás esto pueda ayudar un poco
|
|
lunasoft
Ver perfil usuario
Enviar mensaje privado
Ver los mensajes del usuario
Visite la página de los usuarios
Añadir a la lista de amigos
Habitual Unido: 04/Noviembre/2014 Localización: Graz Estado: Sin conexión Puntos: 100 |
Enviado: 17/Julio/2021 a las 23:47 |
Muchas gracias Maverick2019
|
|
Juanjo Luna (Lunasoft)
Microsoft MVP 2023 ---------------- https://www.luna-soft.es/ https://www.youtube.com/ACCESSoTOTAL https://github.com/ACCESSoTOTAL |
|
Mihura
Ver perfil usuario
Enviar mensaje privado
Ver los mensajes del usuario
Visite la página de los usuarios
Añadir a la lista de amigos
Administrador Unido: 06/Mayo/2005 Localización: En la dehesa Estado: Sin conexión Puntos: 14027 |
Enviado: 17/Julio/2021 a las 23:47 |
Solo por incordiar ...
Juanjo, entiendo que tendrás una función en un módulo independiente, y la llamarás desde el evento Load del formulario ¿no?
|
|
lunasoft
Ver perfil usuario
Enviar mensaje privado
Ver los mensajes del usuario
Visite la página de los usuarios
Añadir a la lista de amigos
Habitual Unido: 04/Noviembre/2014 Localización: Graz Estado: Sin conexión Puntos: 100 |
Enviado: 17/Julio/2021 a las 23:47 |
eso es.
|
|
Juanjo Luna (Lunasoft)
Microsoft MVP 2023 ---------------- https://www.luna-soft.es/ https://www.youtube.com/ACCESSoTOTAL https://github.com/ACCESSoTOTAL |
|
lunasoft
Ver perfil usuario
Enviar mensaje privado
Ver los mensajes del usuario
Visite la página de los usuarios
Añadir a la lista de amigos
Habitual Unido: 04/Noviembre/2014 Localización: Graz Estado: Sin conexión Puntos: 100 |
Enviado: 17/Julio/2021 a las 23:48 |
la solución de Maverick es interesante, pero de momento no la puedo implementar como tenía pensado ya que al usar el DoCmd.OpenForm"aForm", acDesign, , , , acHidden desde el evento Load da error al ya estar abierto el formulario.
Puede que si creo una función que haga algo así funcione:
DoCmd.OpenForm Me.Name, acDesign, , , , acHidden 'aquí tooodos los cambios DoCmd.Close acForm, "aForm", acSaveYes
DoCmd.OpenForm "aForm"<edited><editID>
lunasoft</editID><editDate>2021-07-15 09:12:31</editDate></edited>
|
|
Juanjo Luna (Lunasoft)
Microsoft MVP 2023 ---------------- https://www.luna-soft.es/ https://www.youtube.com/ACCESSoTOTAL https://github.com/ACCESSoTOTAL |
|
Mihura
Ver perfil usuario
Enviar mensaje privado
Ver los mensajes del usuario
Visite la página de los usuarios
Añadir a la lista de amigos
Administrador Unido: 06/Mayo/2005 Localización: En la dehesa Estado: Sin conexión Puntos: 14027 |
Enviado: 17/Julio/2021 a las 23:54 |
Mas que hacerlo cada vez que se cargan los formularios te podrías hacer una rutina propia del 'informático', que lanzarías sólo cuando tengas cambios en el proyecto:
- recorres la colección AllForms
- abres cada formulario
- haces los cambios
- salvas y sales
- siguiente formulario
Así al realizarlo sólo cuando haya cambios, evitas los problemas de tiempos de carga, parpadeos, etc ...
|
|
xavi
Ver perfil usuario
Enviar mensaje privado
Ver los mensajes del usuario
Visite la página de los usuarios
Añadir a la lista de amigos
Administrador Terrassa-BCN Unido: 10/Mayo/2005 Localización: Catalunya |||| Estado: Sin conexión Puntos: 14746 |
Enviado: 17/Julio/2021 a las 23:54 |
Como alternativa mantienes la función de formateo pero modificada para que solo aplique cambios si el formato ha cambiado.
Al salir grabas el formulario siempre.
|
|
lunasoft
Ver perfil usuario
Enviar mensaje privado
Ver los mensajes del usuario
Visite la página de los usuarios
Añadir a la lista de amigos
Habitual Unido: 04/Noviembre/2014 Localización: Graz Estado: Sin conexión Puntos: 100 |
Enviado: 17/Julio/2021 a las 23:54 |
Finalmente el código queda así.
rutina de informático que recorre todos los formularios pero edita solo los que tienen un tag con el fin de evitar incompatibilidades.
Comparto el código
Public Sub fncCabeceraFormulario(miForm As Form)
On Error GoTo fncCabeceraFormulario_Error
'maquetacion de cabecera
With miForm
.Section(0).BackColor = LN_BLANCO
.Section(1).BackColor = LN_GRIS_CLARO
.Section(2).BackColor = LN_BLANCO
End With
If ControlExists("lblTitel", miForm) Then
With miForm.lblTitel 'Item 1
.Left = 128
.Top = 128
.Height = 550 '509
.ForeColor = LN_ROJO_ACCESS
.FontName = "Calibri"
.FontSize = 22
End With
End If
If ControlExists("lnTitel", miForm) Then
With miForm.lnTitel 'Item 10
.Left = miForm.lblTitel.Left
.Top = miForm.lblTitel.Top + miForm.lblTitel.Height + 32
.Width = 10500
.Height = 0
.BorderColor = LN_ROJO_ACCESS
End With
End If
If ControlExists("btnExit", miForm) Then
With miForm.btnExit 'Item 7
.Left = miForm.lnTitel.Left + miForm.lnTitel.Width - .Width
.Top = miForm.lblTitel.Top
.Height = miForm.lblTitel.Height
.Width = .Height
End With
End If
If ControlExists("btnNew", miForm) Then
With miForm.btnNew
.Left = miForm.btnExit.Left - .Width
.Top = miForm.btnExit.Top
.Height = miForm.btnExit.Height
.Width = .Height
End With
End If
Debug.Print miForm.Name & " editado"
On Error GoTo 0
Exit Sub
fncCabeceraFormulario_Error:
' MsgBox "Error " & err.Number & " (" & err.Description & ") in procedure fncCabeceraFormulario, line " & Erl & "."
TSCs_ReportUnexpectedError "fncCabeceraFormulario", miForm.Name, "Error al formatear la cabecera"
End Sub
Public Sub fncCabeceraFormularioEdicion()
On Error GoTo fncCabeceraFormulario_Error
Dim obj As AccessObject, dbs As Object
Dim miForm As Form
Set dbs = Application.CurrentProject
For Each obj In dbs.AllForms
DoCmd.OpenForm obj.Name, acDesign, , , , acHidden
Set miForm = Forms(obj.Name)
Debug.Print miForm.Name & " - " & miForm.Tag
If miForm.Tag Like "editable" Then
fncCabeceraFormulario miForm
DoCmd.Close acForm, obj.Name, acSaveYes
Else
DoCmd.Close acForm, obj.Name
End If
Next obj
Set miForm = Nothing
On Error GoTo 0
Exit Sub
fncCabeceraFormulario_Error:
TSCs_ReportUnexpectedError "fncCabeceraFormularioEdicion", "Modul_Funciones_Globales", "Error al formatear la cabecera"
End Sub
Gracias a todos
SE PUEDE CERRAR EL HILO
|
|
Juanjo Luna (Lunasoft)
Microsoft MVP 2023 ---------------- https://www.luna-soft.es/ https://www.youtube.com/ACCESSoTOTAL https://github.com/ACCESSoTOTAL |
|
Mihura
Ver perfil usuario
Enviar mensaje privado
Ver los mensajes del usuario
Visite la página de los usuarios
Añadir a la lista de amigos
Administrador Unido: 06/Mayo/2005 Localización: En la dehesa Estado: Sin conexión Puntos: 14027 |
Enviado: 17/Julio/2021 a las 23:54 |
Gracias a ti ...
|
|
Responder | |
Tweet
|
Ir al foro | Permisos de foro Usted No puede publicar nuevos temas en este foro Usted No puede responder a temas en este foro Usted No puede borrar sus mensajes en este foro Usted No puede editar sus mensajes en este foro Usted No puede crear encuestas en este foro Usted No puede votar en encuestas en este foro |