Minimize-Maximize-Resizing-Scrolling in a Userform

trishgyrl

New Member
Joined
Jan 16, 2018
Messages
21
Hello.


Is there anyway to enable minimizing, maximizing, resizing, and scrolling with your mouse in a userform?


I noticed that my userform does not have these capabilities and I can't find the properties to enable this functionality.


Any help is greatly appreciated. Thank you!
 

Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!

Jaafar Tribak

Well-known Member
Joined
Dec 5, 2002
Messages
8,387
Office Version
  1. 2016
Platform
  1. Windows
andypope's code is good but the controls are not resized along with the userform.

You can use this alternative API-based code to avoid the above mentioned problem.

1- In a Standard Module :

Code:
Option Explicit

[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  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
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
        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
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  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
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    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) 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
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  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

   [COLOR=#008000] 'OPTIONAL: maximize the form full-screen upon first showing.[/COLOR]
    [COLOR=#008000]'========[/COLOR]
[COLOR=#008000]'    PostMessage hwnd, WM_SYSCOMMAND, SC_MAXIMIZE, 0[/COLOR]
End Sub


Public Sub AdjustSizeOfControls()
    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 in the UserForm Module :
Code:
Option Explicit

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

Private Sub UserForm_Resize()
    Call AdjustSizeOfControls
End Sub

As for adding mouswheel functionality to the userform, you can search this forum as others and myself have posted code here on this topic before.
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
65,919
Office Version
  1. 365
Platform
  1. Windows
Cross posted http://www.vbaexpress.com/forum/sho...ize-Maximize-Resizing-Scrolling-in-a-Userform

Cross-Posting
While we do not prohibit Cross-Posting on this site, we do ask that you please mention you are doing so and provide links in each of the threads pointing to the other thread (see rule 13 here along with the explanation: Forum Rules). This way, other members can see what has already been done in regards to a question, and do not waste time working on a question that may already be answered.
 

Jaafar Tribak

Well-known Member
Joined
Dec 5, 2002
Messages
8,387
Office Version
  1. 2016
Platform
  1. Windows
I've just tested the above code (post#3) on excel 2007 (32bit) and it errors out on the CreateMenu routine because there was a stupid error on the SetWindowLong API delaration... I missed adding the last argument.

So to make the code work with 32bit, anyone using the above code should change the SetWindowLong API declaration form :
Code:
[COLOR=#333333]Private Declare Function SetWindowLong Lib "user32" [/COLOR][COLOR=#417394]Alias[/COLOR][COLOR=#333333] "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long[/COLOR]
To:
Code:
[COLOR=#333333]Private Declare Function SetWindowLong Lib "user32" [/COLOR][COLOR=#417394]Alias[/COLOR][COLOR=#333333] "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long,[/COLOR][COLOR=#ff0000][B] ByVal dwNewLong As Long[/B][/COLOR][COLOR=#333333]) As Long[/COLOR]
 
Last edited:

Forum statistics

Threads
1,148,108
Messages
5,744,874
Members
423,907
Latest member
zerocool88

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top