AJP Excel Information AJP Excel Information

Resize userform

 
 

Form Resizer 

The clase code will add a control to the user form which will allow you to resize the form by dragging the resize handle. No complex APIs required just some code in the Mouse events of the control.
Userform Code
Option Explicit
 
Private m_clsResizer As CResizer
Private Sub CommandButton1_Click()
    Unload Me
End Sub
 
Private Sub CommandButton2_Click()
 
    With Me
        .Move .Left, .Top, .Width * 1.3, .Height * 1.3
    End With
    
End Sub
 
Private Sub CommandButton3_Click()
 
    With Me
        .Move .Left, .Top, .Width / 1.3, .Height / 1.3
    End With
 
End Sub
 
Private Sub UserForm_Initialize()
 
    Set m_clsResizer = New CResizer
    m_clsResizer.Add Me
    
End Sub
 
Private Sub UserForm_Terminate()
 
    Set m_clsResizer = Nothing
    
End Sub
 
 
 
  Class CResizer code
Option Explicit
 
Private Const MFrameResizer = "FrameResizeGrab"
Private Const MResizer = "ResizeGrab"
Private WithEvents m_objResizer As MSForms.Frame
Private m_sngLeftResizePos As Single
Private m_sngTopResizePos As Single
Private m_blnResizing As Single
Private WithEvents m_frmParent As MSForms.UserForm
Private m_objParent As Object
 
Private Sub Class_Terminate()
 
    m_objParent.Controls.Remove MResizer
    
End Sub
 
 
Private Sub m_frmParent_Layout()
    
    If Not m_blnResizing Then
        With m_objResizer
            .Top = m_objParent.InsideHeight - .Height
            .Left = m_objParent.InsideWidth - .Width
        End With
    End If
 
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
    
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
            m_objParent.Width = m_objParent.Width + X - m_sngLeftResizePos
            m_objParent.Height = m_objParent.Height + Y - m_sngTopResizePos
            .Left = m_objParent.InsideWidth - .Width
            .Top = m_objParent.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
 
Public Function Add(Parent As Object) As MSForms.Frame
'
' add resizing control to bottom righthand corner of userform
'
    Dim labTemp As MSForms.Label
    
    Set m_frmParent = Parent
    Set m_objParent = Parent
    
    Set m_objResizer = m_objParent.Controls.Add("Forms.Frame.1", MFrameResizer, True)
    Set labTemp = m_objResizer.Add("Forms.label.1", MResizer, True)
    With labTemp
        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 = 1
        .Left = 1
        .Enabled = False
    End With
    
    With m_objResizer
        .MousePointer = fmMousePointerSizeNWSE
        .BorderStyle = fmBorderStyleNone
        .SpecialEffect = fmSpecialEffectFlat
        .ZOrder
        .Caption = ""
        .Width = labTemp.Width + 1
        .Height = labTemp.Height + 1
        .Top = m_objParent.InsideHeight - .Height
        .Left = m_objParent.InsideWidth - .Width
    End With
End Function
   

Thanks to László Balogh for pointing out the floating sizing handle bug. 
Also thanks to Gary Winey for suggesting the Layout event for altering the position of the resizer control when userform size is alter by other code.
The latest code also uses a frame to hold the label which allows the resizer to appear above controls that a label on its own would not be able to. 

 
Example workbook
   

Created August 2004
Last updated 5th August 2014 

Return to main page Chart Section VBA section Fun and games section Forum files Tips section Links section Book section Site information Site Search RSS feed Top of page


Microsoft® and Microsoft® Excel are registered trademarks of the Microsoft Corporation.
andypope.info is not associated with Microsoft. Copyright ©2007-2016 Andy Pope