jimmy2timez
New Member
- Joined
- Apr 21, 2010
- Messages
- 48
Is there a "simple" code that allows a userform to be resized after it is open?
' Written: July 21, 2019
' Author: Leith Ross
' NOTE: This code should be executed within the UserForm_Activate() event.
' This code works with both 32 bit and 64 bit windows. Requires VBA7.
Public Const SW_HIDE As Long = 0
Public Const SW_NORMAL As Long = 1
Public Const SW_SHOWMINIMIZED As Long = 2
Public Const SW_MAXIMIZED As Long = 3
Public Const WS_MAXIMIZEBOX As Long = &H10000
Public Const WS_MINIMIZEBOX As Long = &H20000
Public Const WS_THICKFRAME As Long = &H40000
Public Const WS_MAXIMIZE As Long = &H1000000
Public Const GWL_STYLE As Long = -16
#If Win64 Then
Public Declare Function GetWindowLong _
Lib "user32.dll" Alias "GetWindowLongPtr" _
(ByVal hwnd As LongPtr, _
ByVal nIndex As Long) _
As LongPtr
Public Declare Function SetWindowLong _
Lib "user32.dll" Alias "SetWindowLongPtr" _
(ByVal hwnd As LongPtr, _
ByVal nIndex As Long, _
ByVal dwNewLong As LongPtr) _
As LongPtr
Public Declare PtrSafe Function ShowWindow _
Lib "user32.dll" _
(ByVal hwnd As LongPtr, _
ByVal nCmdShow As Long) _
As Long
Public Declare Function GetForegroundWindow Lib "user32.dll" () As LongPtr
Public Sub MakeFormResizable()
Dim lStyle As LongPtr
Dim hwnd As LongPtr
Dim RetVal As LongPtr
hwnd = GetForegroundWindow
'Get the basic window style
lStyle = GetWindowLong(hwnd, GWL_STYLE) Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX
'Set the basic window styles
RetVal = SetWindowLong(hwnd, GWL_STYLE, lStyle)
End Sub
Public Sub MakeFormStatic()
Dim lStyle As Long
Dim hwnd As Long
Dim RetVal As LongPtr
hwnd = GetForegroundWindow
'Get the basic window style
lStyle = GetWindowLong(hwnd, GWL_STYLE) And (Not WS_THICKFRAME)
'Set the basic window styles
RetVal = SetWindowLong(hwnd, GWL_STYLE, lStyle)
End Sub
#Else
Public Declare Function GetWindowLong _
Lib "user32.dll" Alias "GetWindowLongA" _
(ByVal hwnd As Long, _
ByVal nIndex As Long) _
As LongPtr
Public Declare Function SetWindowLong _
Lib "user32.dll" Alias "SetWindowLongA" _
(ByVal hwnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) _
As Long
Public Declare Function ShowWindow _
Lib "user32.dll" _
(ByVal hwnd As Long, _
ByVal nCmdShow As Long) _
As Long
Public Declare Function GetForegroundWindow Lib "user32.dll" () As Long
Public Sub MakeFormResizable()
Dim lStyle As Long
Dim hwnd As Long
Dim RetVal As Long
hwnd = GetForegroundWindow
'Get the basic window style
lStyle = GetWindowLong(hwnd, GWL_STYLE) Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX
'Set the basic window styles
RetVal = SetWindowLong(hwnd, GWL_STYLE, lStyle)
End Sub
Public Sub MakeFormStatic()
Dim lStyle As Long
Dim hwnd As Long
Dim RetVal
hwnd = GetForegroundWindow
'Get the basic window style
lStyle = GetWindowLong(hwnd, GWL_STYLE) And (Not WS_THICKFRAME)
'Set the basic window styles
RetVal = SetWindowLong(hwnd, GWL_STYLE, lStyle)
End Sub
#End If
' Written: July 21, 2019
' Author: Leith Ross
' NOTE: This code should be executed within the UserForm_Activate() event.
' This code works with both 32 bit and 64 bit windows. Requires VBA7.
Public Const SW_HIDE As Long = 0
Public Const SW_NORMAL As Long = 1
Public Const SW_SHOWMINIMIZED As Long = 2
Public Const SW_MAXIMIZED As Long = 3
Public Const WS_MAXIMIZEBOX As Long = &H10000
Public Const WS_MINIMIZEBOX As Long = &H20000
Public Const WS_THICKFRAME As Long = &H40000
Public Const WS_MAXIMIZE As Long = &H1000000
Public Const GWL_STYLE As Long = -16
#If Win64 Then
Public Declare PtrSafe Function GetWindowLong _
Lib "user32.dll" Alias "GetWindowLongPtr" _
(ByVal hwnd As LongPtr, _
ByVal nIndex As Long) _
As LongPtr
Public Declare PtrSafe Function SetWindowLong _
Lib "user32.dll" Alias "SetWindowLongPtr" _
(ByVal hwnd As LongPtr, _
ByVal nIndex As Long, _
ByVal dwNewLong As LongPtr) _
As LongPtr
Public Declare PtrSafe Function ShowWindow _
Lib "user32.dll" _
(ByVal hwnd As LongPtr, _
ByVal nCmdShow As Long) _
As Long
Public Declare PtrSafe Function GetForegroundWindow Lib "user32.dll" () As LongPtr
Public Sub MakeFormResizable()
Dim lStyle As LongPtr
Dim hwnd As LongPtr
Dim RetVal As LongPtr
hwnd = GetForegroundWindow
'Get the basic window style
lStyle = GetWindowLong(hwnd, GWL_STYLE) Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX
'Set the basic window styles
RetVal = SetWindowLong(hwnd, GWL_STYLE, lStyle)
End Sub
#Else
Public Declare Function GetWindowLong _
Lib "user32.dll" Alias "GetWindowLongA" _
(ByVal hwnd As Long, _
ByVal nIndex As Long) _
As Long
Public Declare Function SetWindowLong _
Lib "user32.dll" Alias "SetWindowLongA" _
(ByVal hwnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) _
As Long
Public Declare Function ShowWindow _
Lib "user32.dll" _
(ByVal hwnd As Long, _
ByVal nCmdShow As Long) _
As Long
Public Declare Function GetForegroundWindow Lib "user32.dll" () As Long
Public Sub MakeFormResizable()
Dim lStyle As Long
Dim hwnd As Long
Dim RetVal As Long
hwnd = GetForegroundWindow
'Get the basic window style
lStyle = GetWindowLong(hwnd, GWL_STYLE) Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX
'Set the basic window styles
RetVal = SetWindowLong(hwnd, GWL_STYLE, lStyle)
End Sub
#End If
me.Zoom = 80
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
Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
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]
Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (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=End"]#End[/URL] If
Declare PtrSafe Function WindowFromAccessibleObject Lib "oleacc" (ByVal pacc As IAccessible, phwnd As LongPtr) As Long
Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hwnd As LongPtr) As Long
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL]
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function WindowFromAccessibleObject Lib "oleacc" (ByVal pacc As IAccessible, phwnd As Long) As Long
Declare Function DrawMenuBar Lib "user32" Alias "DrawMenuBar" (ByVal hwnd As Long) As Long
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL] If
Const WS_MAXIMIZEBOX As Long = &H10000
Const WS_MINIMIZEBOX As Long = &H20000
Const WS_THICKFRAME As Long = &H40000
Const WS_MAXIMIZE As Long = &H1000000
Const GWL_STYLE As Long = -16
Public Property Let MakeFormResizable(ByVal Form As UserForm, ByVal Resizable As Boolean)
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL] VBA7 Then
Dim hwnd As LongPtr
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL]
Dim hwnd As Long
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL] If
WindowFromAccessibleObject Form, hwnd
If Resizable Then
Call SetWindowLong(hwnd, GWL_STYLE, GetWindowLong(hwnd, GWL_STYLE) Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX)
Else
Call SetWindowLong(hwnd, GWL_STYLE, GetWindowLong(hwnd, GWL_STYLE) And (Not WS_THICKFRAME) And (Not WS_MINIMIZEBOX) And (Not WS_MAXIMIZEBOX))
End If
DrawMenuBar hwnd
End Property
Private Sub UserForm_Initialize()
MakeFormResizable(Me) = True
End Sub
Declare PtrSafe Function WindowFromAccessibleObject Lib "oleacc" (ByVal pacc [B][COLOR=#ff0000]As Any[/COLOR][/B] , phwnd As LongPtr) As Long
Now, I do not receive any error, but the form is not resizable.
Let me tell you what resizable mean for me... I have a button trying to zoom the form keeping the code 'me.Zoom = 80'. When I press it, all controlls (except the form dimensions) are decreased at 80%. I need the form itself to decrease its dimensions with the same ratio...