Resize Userform with grab handles

[tony.reynolds]

Im Trying to create a userform that behaves similar to normal windows (i.e. can be resized to whatever size the user wants.
I have got a fair way with the minimize and maximimize buttons .. now i need to have a grab handle in the corner or make the borders activate resize handles

below is the code so far which works really well so far.

Can soemone help me with code for resizing?

Option Compare Text


Option Explicit
Private Declare Function SendMessage Lib "USER32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Long) As Long
Private Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
Private Declare Function GetActiveWindow32 Lib "USER32" Alias "GetActiveWindow" () As Integer
Private Declare Function GetWindowLong Lib "USER32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
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 SetWindowLong Lib "USER32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetFocus Lib "USER32" (ByVal hwnd As Long) As Long
Private Const GWL_STYLE As Long = -16
Private Const GWL_EXSTYLE As Long = -20
Private Const WS_CAPTION As Long = &HC00000
Private Const WS_MINIMIZEBOX As Long = &H20000
Private Const WS_MAXIMIZEBOX As Long = &H10000
Private Const WS_POPUP As Long = &H80000000
Private Const WS_VISIBLE As Long = &H10000000
Private Const WS_EX_DLGMODALFRAME As Long = &H1
Private Const WS_EX_APPWINDOW As Long = &H40000
Private Const SW_SHOW As Long = 5
Private Const WM_SETICON = &H80


Private Sub CommandButtonCloseMe_Click()


Workbooks("XYZ.xlsm").Save
Unload Me


End Sub


Private Sub UserForm_Activate()
Dim lngHwnd As Long
Dim lngCurrentStyle As Long
Dim lngNewStyle As Long
Dim lngXLHwnd As Long
Dim lngIcon As Long
Dim strIconPath As String


Application.Visible = True


UserFormPengarMainWindow.Top = Range("OptionsDataWindowTop").Value
UserFormPengarMainWindow.Left = Range("OptionsDataWindowLeft").Value


lngHwnd = FindWindow("ThunderDFrame", Me.Caption)
'''''''''Set the Windows style so that the userform has a minimise and maximise button
lngCurrentStyle = GetWindowLong(lngHwnd, GWL_STYLE)
lngNewStyle = lngCurrentStyle Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX
lngNewStyle = lngNewStyle And Not WS_VISIBLE And Not WS_POPUP
SetWindowLong lngHwnd, GWL_STYLE, lngNewStyle
''''''''''Set the extended style to provide a taskbar icon
lngCurrentStyle = GetWindowLong(lngHwnd, GWL_EXSTYLE)
lngNewStyle = lngCurrentStyle Or WS_EX_APPWINDOW
SetWindowLong lngHwnd, GWL_EXSTYLE, lngNewStyle
ShowWindow lngHwnd, SW_SHOW
''''''''''Add a Icon to the Taskbar and Window Frame
strIconPath = ActiveWorkbook.Path & "\PengarIcon.ico"
lngXLHwnd = FindWindow("XYZ", Application.Caption)
lngIcon = ExtractIcon(0, strIconPath, 0)
SendMessage lngXLHwnd, WM_SETICON, False, lngIcon
SendMessage GetActiveWindow32(), &H80, 1, lngIcon '< 1 = big Icon
SendMessage GetActiveWindow32(), &H80, 0, lngIcon '< 0 = small Icon


End Sub

 

[djreiswig]

http://www.mrexcel.com/forum/excel-questions/558649-userform-movable-resizable.html
Look at the 3rd post. I think it does what you need.

 

[mikerickson]

You can do this without all those API calls. A text box in the lower right corner will suffice

' in userform code module

Dim startX As Single, startY As Single

Private Sub TextBox1_Enter()
    With Me.TextBox1
        .SelStart = 10
    End With
End Sub

Private Sub TextBox1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
    startX = x
    startY = y
    TextBox1.SelStart = 10
End Sub

Private Sub TextBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
    Dim xDif As Single, yDif As Single
    If 0 < startX And 0 < startY Then
        xDif = x - startX
        yDif = y - startY
        Application.ScreenUpdating = False
        With Me
            .Height = .Height + yDif
            .Width = .Width + xDif
            With .TextBox1
                .Top = .Top + yDif
                .Left = .Left + xDif
                .ZOrder 0
            End With
        End With
        Application.ScreenUpdating = True
        TextBox1.SelStart = 10
    End If
End Sub

Private Sub TextBox1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
    startX = 0: startY = 0
End Sub

Private Sub UserForm_Activate()
    With Me.TextBox1
        .Left = Me.InsideWidth - .Width
        .Top = Me.InsideHeight - .Height
    End With
End Sub

Private Sub UserForm_Initialize()
    Rem these can be set at design time
    With TextBox1
        .AutoWordSelect = False
        .BackColor = Me.BackColor
        .BorderStyle = fmBorderStyleSingle
        .EnterFieldBehavior = fmEnterFieldBehaviorRecallSelection
        .Locked = False
        .MaxLength = 0
        .MousePointer = fmMousePointerArrow
        .MultiLine = True
        .TabStop = False
        .Text = Space(20): .Locked = True
        .WordWrap = False
        .Width = 20: .Height = 20
    End With
End Sub

 

[djreiswig]

Might also look at this. It resizes all of the controls as well as the form.
Anchor controls and resizing userfrom

 

[tony.reynolds]

You can do this without all those API calls. A text box in the lower right corner will suffice

Thanks for that... I've moved a few ideas around and have it mostly how i want now.

only thing is whan i have the userform maximized it go to error saying i cannot re size an object if it is minimized or maximized. ive tried

If Not ActiveWindow.WindowState = xlMaximized Then...

Also..

what do you mean I can do without all those API Calls...? Can i make the userform have minimize and maximize buttons without all that code?

 

[mikerickson]

I'm a Mac user and Mac's FullScreen mode differs from Windows Maximized. So, I'm not clear what you mean by a Maximize button for a userform, fill the Excel Window or be a FullScreen userform....

One can use the .Top, .Height, .InteriorHeight properties of windows and forms to mimic 'most any sizing effect.