You are here VBA and Macro Resize controls when userform is resize or maximized

Resize controls when userform is resize or maximized

When we design Usserform with controls it is condinate with your screen. When userform resize we want to resize all controls. I have a good solution by Userform.Zoom property, it is very simple.

 

Private Const ZoomMin = 10 
Private Const ZoomMax = 400 

Public hWnd&, PrevStyle&
Dim OldWidth As Double, OldHeight As Double
Dim AllowResize As Boolean

Private Sub UserForm_Activate()
    ShowWindow hWnd, SW_MAXIMIZE
End Sub

Private Sub UserForm_Initialize()
    AllowResize = True
    OldWidth = Width
    OldHeight = Height
    If Val(Application.Version) < 9 Then
        hWnd = FindWindow("ThunderXFrame", Caption)  'XL97
    Else
        hWnd = FindWindow("ThunderDFrame", Caption)  'XL2000
    End If

    PrevStyle = GetWindowLong(hWnd, GWL_STYLE)
    SetWindowLong hWnd, GWL_STYLE, PrevStyle _
                                Or WS_SIZEBOX _
                                Or WS_MINIMIZEBOX _
                                Or WS_MAXIMIZEBOX
End Sub

Private Sub UserForm_Terminate()
    SetWindowLong hWnd, GWL_STYLE, PrevStyle
End Sub

Private Sub UserForm_Resize()
    Dim tmpZoom As Long, CurStyle&
    If Not AllowResize Then Exit Sub
    CurStyle = GetWindowLong(hWnd, GWL_STYLE)
    tmpZoom = Round(Width / OldWidth * 100, 0)
    If tmpZoom < ZoomMin Then tmpZoom = ZoomMin
    If tmpZoom > ZoomMax Then tmpZoom = ZoomMax
    
    AllowResize = False 'Ngan khong chay UserForm_Resize khi dang thay doi size
    
    If tmpZoom = ZoomMin Or tmpZoom = ZoomMax Then
        'Neu khong phai la phong to man hinh thi co lai kich co
        If Not (CurStyle And WS_MAXIMIZE) = WS_MAXIMIZE Then
            Width = tmpZoom * OldWidth / 100
            Height = Width * OldHeight / OldWidth
        End If
    End If
    AllowResize = True 'Cho phep resize
    Zoom = tmpZoom
End Sub

Support code for Userform can resize you must use Windows API function:
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, _
ByVal nCmdShow As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
  (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
  
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex 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
Ahthor: Nguyen Duy Tuan - BLUESOFTS.,jsc You can download sourcecode