autosizing userform display

M

medic5678

Board Regular
Joined
Nov 13, 2018
Messages
67
I have a userform where I need to have the entire form visible on screen of any computer excel runs on. The size of both the form and the various controls/text in the userform need to be resized.

This is something that I of course never considered as an issue, thinking excel would do this automatically. Instead, it only shows a part of the form depending on which computer I run it on.
 
Sort by date Sort by votes
I'm curious how this script would work. How does the script know how you want your Userform Resized?

If your userform now is 4 inches High and 4 inches wide for example how does the script know how you want it now resized.

And how can it resize a Option Button for example or a Combobox ?

If I have 40 controls on my Userform how would this script know how to reposition and resize all these controls? Without just using Scrollbars.
 
Upvote 0

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.
My Aswer Is This said:
I'm curious how this script would work. How does the script know how you want your Userform Resized?

If your userform now is 4 inches High and 4 inches wide for example how does the script know how you want it now resized.

And how can it resize a Option Button for example or a Combobox ?

If I have 40 controls on my Userform how would this script know how to reposition and resize all these controls? Without just using Scrollbars.
Click to expand...

If you are so curious about Jaafar 's brilliant code ...

Why don't you just test it ...???
 
Upvote 0
James006 said:
If you are so curious about Jaafar 's brilliant code ...

Why don't you just test it ...???
Click to expand...

I really do not like using scripts that I do not understand. Especially scripts with this much code. But thanks.
 
Upvote 0
medic5678 said:
I'll be the first to tell you that this is totally over my newbie head.

I pasted the code in a new module (using Excel 2016, windows 10 64 bit). And I put the code in my userform, so it's called upon initiation. Doesn't seem to have any effect at all. Of course, I'm handicapped by ignorance so I don't really know how to use it. One of the things that seems curious is in the module I pasted the code in, several lines are highlighted in red.

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

Not sure what this means.

Any general pointers would be much appreciated. Obviously, this is brilliant work and I don't know what I've done to keep it from working as intended. I do appreciate your post.
Click to expand...

Hi medic5678,
I commented out all the errors on windows7 64bit, excel 2013 and it works very fine.

The only issue is that it opens up by default as full screen. Is there a way to customise the default size?

Any help from anyone will be appreciated.
 
Upvote 0
Jaafar Tribak said:
The following code should allow both the userform and the various controls/text in the userform to be resized along with it.

workbook demo.

1- Code 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, 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
[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

   [B][COLOR=#008000] 'OPTIONAL: maximize the form full-screen upon first showing.[/COLOR][/B]
    [COLOR=#008000][B]'========[/B][/COLOR]
    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 in the UserForm Module:
Code: 
Option Explicit

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

Private Sub UserForm_Resize()
    Call AdjustSizeOfControls
End Sub
Click to expand...
Hi Jaafar, I've seen your codes for resizable userforms in several threads, but can't seem to get them to work. Even if I download the workbook you attached, the userform is not resizable. I can't drag any of the sides. I use Office 365 for clarifications sake. Any idea how I can get it working for 365?
 
Upvote 0
Jaafar Tribak said:
The following code should allow both the userform and the various controls/text in the userform to be resized along with it.

workbook demo.

1- Code 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, 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
[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

   [B][COLOR=#008000] 'OPTIONAL: maximize the form full-screen upon first showing.[/COLOR][/B]
    [COLOR=#008000][B]'========[/B][/COLOR]
    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 in the UserForm Module:
Code: 
Option Explicit

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

Private Sub UserForm_Resize()
    Call AdjustSizeOfControls
End Sub
Click to expand...
@Jaafar Tribak I have added the code same as above and added ptr safe as well as it is 64 but but below lines are showing in red color . Could you please help on where is the problem.

#If VBA7 Then
#If Win64 Then
#Else
#End If
#Else
#End If
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Question
Forced to discard digital signature after opening and immediately saving an Macro-Enabled Excel file
Replies
0
Views
75
JDCreate
J
T
  • Question
"Compile Error: Out of memory" with complex userform and many vba subroutines
Replies
1
Views
187
toole123
T
A
  • Question
Control A does not work in Excel on my computer
Replies
9
Views
342
Andy0311
A
H
  • Solved
Catching the Mouse Click Error in Modal User Form
Replies
4
Views
275
huiettcm
H
A
  • Solved
Calendar form cancel button passing data to worksheet
Replies
7
Views
382
AndyEd
A

Forum statistics

Threads
1,214,614
Messages
6,120,517
Members
448,968
Latest member
Ajax40

Share this page

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
Back
Top