Descargas, guías, trucos, gameplays...

jueves, 24 de mayo de 2012

Minimizar y maximizar formularios VBA en Excel





El siguiente es un código muy útil que encontré en una web para agregar los botones de minimizar y maximizar a los UserForm:
Option Explicit
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 Const WS_MINIMIZEBOX As Long = &H20000
Private Const WS_MAXIMIZEBOX As Long = &H10000
Private Const GWL_STYLE As Long = (-16)

Private Sub UserForm_Initialize()
    Dim lngMyHandle As Long, lngCurrentStyle As Long, lngNewStyle As Long
    If Application.Version < 9 Then
        lngMyHandle = FindWindow("THUNDERXFRAME", Me.Caption)
    Else
        lngMyHandle = FindWindow("THUNDERDFRAME", Me.Caption)
    End If
    lngCurrentStyle = GetWindowLong(lngMyHandle, GWL_STYLE)
    lngNewStyle = lngCurrentStyle Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX
    SetWindowLong lngMyHandle, GWL_STYLE, lngNewStyle
End Sub



Es bastante simple de usar. Solamente lo copian y pegan en el UserForm creado y en propiedades se le marca como "False" la que se llama "ShowModal":




El código lo encontré aquí

6 comentarios:

  1. Hola, no me funciona este código me a un error de compilación, dice que los comentarios deben ponerce después de End Sub, End Funtion o End Property

    ResponderEliminar
  2. Jose Manuel,

    Me pasó lo mismo.

    Saqué este set de instrucciones del formulario y lo puse en un modulo y me funcionó perfecto.

    Gracias Wilian, espero que te llegue este reconocimiento después de 4 años que hiciste el aporte... :)

    Option Explicit
    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 Const WS_MINIMIZEBOX As Long = &H20000
    Private Const WS_MAXIMIZEBOX As Long = &H10000
    Private Const GWL_STYLE As Long = (-16)

    ResponderEliminar
    Respuestas
    1. Por nada. Gracias por la aclaración para que funcione.

      Eliminar
  3. No me funciona el codigo me aparce que solo corre para 32 bits y hay que marcar el atributo PtrSafe

    ResponderEliminar
  4. Muchas gracias, alguien sabe como una vez minimizada o maximizado el formulario, mediante código restaurarlo al tamaño normal. Vamos mediante código vba hacer como si le hubiera dado al botón "restaurar". Gracias

    ResponderEliminar