Ajuste de Formulario

[rhg_83]

hola amigos del Foro, tengo unas dudas, estoy realizando unos formularios en Excel VBA y estoy buscando como ajustarlos a la pantalla de la computadora, ya que estos formularios se van a ejecutar en diferentes equipos y lo que pretendo es que se ajusten en automatico de acuerdo al monitor...

 

espero y me puedan apoyar en darme una idea...no subo un archivo ya que solo es un formulario normal.....

 

gracias por su gran ayuda y apoyo....

 

Saludos amigos....

[LeandroA]

hola coloca este código dentro de un userform, fijate que puse un comentario que si quieres mostrarlo en fullscreen comentas las tres líneas de lo contrario la barra de tareas sigue visible.

	Option Explicit
#If VBA7 Then
    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    Private Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal Hwnd As LongPtr) As Long
    Private Declare PtrSafe Function GetWindowPlacement Lib "user32" (ByVal Hwnd As LongPtr, lpwndpl As WINDOWPLACEMENT) As Long
    Private Declare PtrSafe Function SetWindowPlacement Lib "user32" (ByVal Hwnd As LongPtr, lpwndpl As WINDOWPLACEMENT) As Long
    
    #If Win64 Then
        Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongPtrA" (ByVal Hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
        Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongPtrA" (ByVal Hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
    #Else
        Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal Hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
        Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal Hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
    #End If
#Else
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
    Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
    Private Declare Function GetWindowPlacement Lib "user32" (ByVal hwnd As Long, lpwndpl As WINDOWPLACEMENT) As Long
    Private Declare Function SetWindowPlacement Lib "user32" (ByVal hwnd As Long, lpwndpl As WINDOWPLACEMENT) As Long
	#End If
	Private Type POINTAPI
    x As Long
    y As Long
End Type
	Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
	
Private Type WINDOWPLACEMENT
    Length As Long
    flags As Long
    showCmd As Long
    ptMinPosition As POINTAPI
    ptMaxPosition As POINTAPI
    rcNormalPosition As RECT
End Type
	
Private Const WS_MINIMIZEBOX As Long = &H20000
Private Const WS_MAXIMIZEBOX As Long = &H10000
Private Const SW_SHOWMAXIMIZED As Long = 3
Private Const GWL_STYLE As Long = (-16)
	Private Sub UserForm_Activate()
   Dim Hwnd, lngCurrentStyle, lngNewStyle
   Dim WP As WINDOWPLACEMENT
   
    If Application.Version < 9 Then
        Hwnd = FindWindow("THUNDERXFRAME", Me.Caption)
    Else
        Hwnd = FindWindow("THUNDERDFRAME", Me.Caption)
    End If
    
    'comentar estas tres lineas si se quiere full screen.
    lngCurrentStyle = GetWindowLong(Hwnd, GWL_STYLE)
    lngNewStyle = lngCurrentStyle Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX
    SetWindowLong Hwnd, GWL_STYLE, lngNewStyle
    
    
    GetWindowPlacement Hwnd, WP
    WP.showCmd = SW_SHOWMAXIMIZED
    SetWindowPlacement Hwnd, WP
End Sub
	

[rhg_83]

gracias LeandroA por tu aporte es muy bueno.... ya realizace el formulario y agregue el codigo y al ejecutar me inidca un mensaje de errror falatria alguna libreria para que se pueda ejecura el formulario??

 

gracias por tu ayuda!!!

[LeandroA]

Hace 2 horas, rhg_83 dijo:

gracias LeandroA por tu aporte es muy bueno.... ya realizace el formulario y agregue el codigo y al ejecutar me inidca un mensaje de errror falatria alguna libreria para que se pueda ejecura el formulario??

 

gracias por tu ayuda!!!

hola siempre debes poner una captura o indicar cual es el error para poder ayudarte, no se requiere ninguna librería extra de las que tiene windows. te subo el archivo adjunto y dices donde te da error o mejor pones una captura de pantalla.

 

Libro1.xlsm

[rhg_83]

Gracias LeandroA por el adjunto ya vi donde estaba mi error, indique la subrutina:

Private Sub UserForm_Initialize()

sin embargo era de

Private Sub UserForm_Activate()

 

gracias por el aporte y la respuesta rapida es un excelente codigo para los formularios...

 

execelente dia...y doy el tema por solucionado...

 

Gracias!!!