Userform movable and resizable

[Jaye7]

I have the following script which makes it so that you can resize a userform by dragging the bottom right corner.

Can anyone please provide a script so that I can resize it from
1 - The top right corner
2 - The bottom left corner
3 - The top left corner.

Sometimes I have textboxes in certain positions and want to resize to fit a specific textbox which this does not allow and will include every textbox above the textbox that I want.

Dim myClipbd As New DataObject
Private m_sngX As Single
Private m_sngY As Single
Option Explicit

Private Const MResizer = "ResizeGrab"
Private WithEvents m_objResizer As MSForms.Label
Private m_sngLeftResizePos As Single
Private m_sngTopResizePos As Single
Private m_blnResizing As Single



Private Sub UserForm_Activate()


'RemoveCaption GetForegroundWindow

'Call formheight




Set m_objResizer = Me.Controls.Add("Forms.label.1", MResizer, True)
    With m_objResizer
        With .Font
            .Name = "Marlett"
            .Charset = 2
            .Size = 14
            .Bold = True
        End With
        .BackStyle = fmBackStyleTransparent
        .AutoSize = True
        .BorderStyle = fmBorderStyleNone
        .Caption = "o"
        .MousePointer = fmMousePointerSizeNWSE
        .ForeColor = RGB(100, 100, 100)
        .ZOrder
        .Top = Me.InsideHeight - .Height
        .Left = Me.InsideWidth - .Width
    End With
End Sub



Private Sub m_AddResizer()
'
' add resizing control to bottom righthand corner of userform
'
    
    
End Sub

Private Sub m_objResizer_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

    If Button = 1 Then
        m_sngLeftResizePos = X
        m_sngTopResizePos = Y
        m_blnResizing = True
        
    End If
    

'If Button = 1 Then

'End If

'If Button And 1 Then

'End If

    
    
End Sub
Private Sub m_objResizer_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

    If Button = 1 Then
        With m_objResizer
            .Move .Left + X - m_sngLeftResizePos, .Top + Y - m_sngTopResizePos
            Me.Width = Me.Width + X - m_sngLeftResizePos
            Me.Height = Me.Height + Y - m_sngTopResizePos
            .Left = Me.InsideWidth - .Width
            .Top = Me.InsideHeight - .Height
        End With
    End If
    
End Sub
Private Sub m_objResizer_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If Button = 1 Then
        m_blnResizing = False
    End If
End Sub



Private Sub UserForm_Initialize()

   ' m_AddResizer
    
End Sub
Private Sub UserForm_Terminate()

    Me.Controls.Remove MResizer
    
End Sub


Private Sub UserForm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

If Button = 1 Then
m_sngX = X
m_sngY = Y
End If
End Sub
Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

If Button = 1 Then
Me.Left = X + Me.Left - m_sngX
Me.Top = Y + Me.Top - m_sngY

End If
End Sub

 

[RawlinsCross]

I've tried this resizing code and it's very neat to see it work. So thanks for that.

I have userforms that are large and when I resize them small (for example when I'm using a laptop instead of a monitor) and reduce them below the size of the original, I lose content. Is there a way to introduce scroll bars so that I can still scroll around the entire userform?

RC

 

[mikerickson]

You can do that with the .ScrollBars property of the userform.
Note that the .ScrollHeight and .ScrollWidth properties have be set appropriatly.
Note also that the .InsideHeight and .InsideWidth properties are not reliable until after or while the Activate event runs.

Private Sub CommandButton1_Click()
    Rem make narrow
    Me.Width = 150
    Me.ScrollBars = fmScrollBarsHorizontal Or Me.ScrollBars
End Sub

Private Sub CommandButton2_Click()
    Rem make wide
    With Me
        .Width = 400
        .ScrollBars = .ScrollBars And fmScrollBarsVertical
    End With
End Sub

Private Sub CommandButton3_Click()
    Rem make tall
    With Me
        .Height = 400
        .ScrollBars = .ScrollBars And fmScrollBarsHorizontal
    End With
End Sub

Private Sub CommandButton4_Click()
    Rem make short
    With Me
        .Height = 200
        .ScrollBars = .ScrollBars Or fmScrollBarsVertical
    End With
End Sub

Private Sub UserForm_Activate()
    Dim maxWidth As Single, maxHeight As Single
    Dim oneCont As msforms.Control
    With UserForm1
        For Each oneCont In .Controls
            With oneCont
                If maxWidth < .Left + .Width Then maxWidth = .Left + .Width
                If maxHeight < .Top + .Height Then maxHeight = .Top + .Height
            End With
        Next oneCont
        .ScrollHeight = maxHeight + 10 + (.Height - .InsideHeight)
        .ScrollWidth = maxWidth + 10 + (.Width = .InsideWidth)
    End With
End Sub

 

[RawlinsCross]

Thanks for the reply. So if I understand it correctly. I change the width and height to that of my own userform. And I use the code under the Userform_Activate() sub. But I don't understand the command buttons. Do I need to add 4 command buttons to my userform?

 

[mikerickson]

The Activate routine finds the largest width/height that you would ever want to see and sets the .ScrollWidth/.ScrollHeight property values.
The .ScrollBars property determines which scroll bars you see, horizontal or vertical.
The four command buttons are just for demo, showing how to manipulate the .ScrollBar property. You don't need the command buttons, but you will need the .ScrollBar code (or something similar) when you resize the UF with whatever code you already have.

 

[vbalover2203]

Hello Jaye7,

Copy this code to a separate VBA module. Add a call to the macro MakeFormResizable in the UserForm's UserForm_Activate() event. You cna then resize it like a regular window.

'Written: February 14, 2011
'Author:  Leith Ross
'
'NOTE:  This code should be executed within the UserForm_Activate() event.

Private Declare Function GetForegroundWindow Lib "User32.dll" () As Long

Private Declare Function GetWindowLong _
  Lib "User32.dll" Alias "GetWindowLongA" _
    (ByVal hWnd As Long, _
     ByVal nIndex As Long) _
  As Long
               
Private Declare Function SetWindowLong _
  Lib "User32.dll" Alias "SetWindowLongA" _
    (ByVal hWnd As Long, _
     ByVal nIndex As Long, _
     ByVal dwNewLong As Long) _
  As Long

Private Const WS_THICKFRAME As Long = &H40000
Private Const GWL_STYLE As Long = -16

Public Sub MakeFormResizable()

  Dim lStyle As Long
  Dim hWnd As Long
  Dim RetVal
  
    hWnd = GetForegroundWindow
  
    'Get the basic window style
     lStyle = GetWindowLong(hWnd, GWL_STYLE) Or WS_THICKFRAME

    'Set the basic window styles
     RetVal = SetWindowLong(hWnd, GWL_STYLE, lStyle)

End Sub

Sincerely,
Leith ROss

Hi @Leith, I have a frame inside my userform, how can I make the frame resize at the same time as I resize the userform? Thank you for your code. It helped so much!

 

[vbalover2203]

Hi. I meant to ask the questions to everyone, not just Leith. Thanks

 

[Jaafar Tribak]

Hi. I meant to ask the questions to everyone, not just Leith. Thanks

https://www.mrexcel.com/forum/excel-questions/1078144-autosizing-userform-display.html#post5179915

 

[kjelban]

Hello Al,

You only need to use LongPtr if your Windows system is 64 bit and your version of Office is also 64 bit. If you are running 32 bit Office on 64 bit Windows , like a typical Windows 7 installation, then it is taken care of automatically.

this is not working!!!