Full size userform

[Sharid]

I have this code that makes my userform full page, the problem is that any other objects on the userform do not do the same, like multipages, buttons, images textboxes, etc.
Is there was to do it so that everything will expand. I was testing it on this form, see the attached picture

Private Sub Userform_Activate()
With Application
   Me.Top = .Top
    Me.Left = .Left
    Me.Height = .Height
    Me.Width = .Width
End With
End Sub

The multipage was the original size of the userform, the above code expanded the form, but everything else stayed the size it was designed. Is there a way to do it so everything changes size

Thanks

 

[GWteB]

You have to do some calculation for each control on your Userform. Those calculations should be done in the

Private Sub UserForm_Resize()
   ' your code to calculate Top, Left, Height and Width of each separate control
End Sub

 

[Sharid]

Hi GWteB

I was hopping that there would be a faster ways, as I have 12 tabs on the multipage and many items on them, it will too big a job. If there is no quick fix, i will have to leave it as it is as it would be a big job.

Thanks for the reply

 

[GWteB]

No, there is no quick fix, it's custom work (and a big job too ...)
You are welcome!

 

[Jaafar Tribak]

See if this works for you :

ResizeUserFormAndControls.xls


1- API Code in a Standard Module:

Option Explicit

#If VBA7 Then
    #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 Long) As LongPtr
    #End If
    Private Declare PtrSafe Function WindowFromAccessibleObject Lib "oleacc" (ByVal pacc As IAccessible, phwnd As LongPtr) As Long
    Private Declare PtrSafe Function DrawMenuBar Lib "User32.dll" (ByVal hwnd As LongPtr) As Long
    Private Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As Long
    Private hwnd As LongPtr
    Private lStyle As LongPtr
#Else
    Private Declare Function WindowFromAccessibleObject Lib "oleacc" (ByVal pacc As IAccessible, phwnd 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 SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Private Declare Function DrawMenuBar Lib "user32.dll" (ByVal hwnd As Long) As Long
    Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Private hwnd As Long
    Private lStyle As Long
#End If

Private Const GWL_STYLE = -16
Private Const WS_SYSMENU = &H80000
Private Const WS_MINIMIZEBOX = &H20000
Private Const WS_MAXIMIZEBOX = &H10000
Private Const WS_THICKFRAME = &H40000
Private Const WM_SYSCOMMAND = &H112
Private Const SC_MAXIMIZE = &HF030&

Private dInitWidth As Single
Private dInitHeight As Single
Private Ufrm As Object


Public Sub MakeFormResizeable(ByVal UF As Object)
    Set Ufrm = UF
    Call CreateMenu
    Call StoreInitialControlMetrics

    'OPTIONAL: maximize the form full-screen upon first showing.
    '========
    PostMessage hwnd, WM_SYSCOMMAND, SC_MAXIMIZE, 0
End Sub


Public Sub AdjustSizeOfControls(Optional ByVal Dummey As Boolean)
    Dim oCtrl As Control
 
    For Each oCtrl In Ufrm.Controls
        With oCtrl
            If .Tag <> "" Then
                .Width = Split(.Tag, "*")(0) * ((Ufrm.InsideWidth) / dInitWidth)
                .Left = Split(.Tag, "*")(1) * (Ufrm.InsideWidth) / dInitWidth
                .Height = Split(.Tag, "*")(2) * (Ufrm.InsideHeight) / dInitHeight
                .Top = Split(.Tag, "*")(3) * (Ufrm.InsideHeight) / dInitHeight
                If HasFont(oCtrl) Then
                    .Font.Size = Split(.Tag, "*")(4) * (Ufrm.InsideWidth) / dInitWidth
                End If
            End If
        End With
    Next
    Ufrm.Repaint
End Sub

Private Sub StoreInitialControlMetrics()
    Dim oCtrl As Control
    Dim dFontSize As Currency

    dInitWidth = Ufrm.InsideWidth
    dInitHeight = Ufrm.InsideHeight
    For Each oCtrl In Ufrm.Controls
        With oCtrl
            On Error Resume Next
                dFontSize = IIf(HasFont(oCtrl), .Font.Size, 0)
            On Error GoTo 0
            .Tag = .Width & "*" & .Left & "*" & .Height & "*" & .Top & "*" & dFontSize
        End With
    Next
End Sub
 
Private Sub CreateMenu()
    Call WindowFromAccessibleObject(Ufrm, hwnd)
    lStyle = GetWindowLong(hwnd, GWL_STYLE)
    lStyle = lStyle Or WS_SYSMENU Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX Or WS_THICKFRAME
    SetWindowLong hwnd, GWL_STYLE, lStyle
    DrawMenuBar hwnd
End Sub

Private Function HasFont(ByVal oCtrl As Control) As Boolean
    Dim oFont As Object
    
    On Error Resume Next
    Set oFont = CallByName(oCtrl, "Font", VbGet)
    HasFont = Not oFont Is Nothing
End Function

2- Code Usage in the UserForm Module:

Option Explicit

Private Sub UserForm_Initialize()
    Call MakeFormResizeable(Me)
End Sub

Private Sub UserForm_Resize()
    Call AdjustSizeOfControls
End Sub

 

[GWteB]

@Jaafar Tribak, I like your approach ( ... and the fact that you take visually impaired people into account).

 

[Sharid]

Its good, but the multipage did not expand, see image

 

[GWteB]

Sure it did! All controls expand relative to the height and width of the userform. Decrease the initial width of your userform (during design time) and watch what happens ...

 

[Sharid]

LoL your right, I'm wrong.
I think it time to take my medication, double dosage.

 

[Jaafar Tribak]

LoL your right, I'm wrong.
I think it time to take my medication, double dosage.