AJP Excel Information

Charts













 
 

Resize userform

The code below 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.
   
 
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 m_AddResizer()
'
' add resizing control to bottom right hand corner of userform
'
    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 
CommandButton1_Click()
    
Unload Me
End Sub
Private Sub 
m_objResizer_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal As Single, ByVal 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 As Single, ByVal 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

' 27-May-2006 Addition of code to make sure sizing handle remains fixed in the bottom right hand corner
            .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 As Single, ByVal 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
Thanks to László Balogh for pointing out the floating sizing handle bug.
Example workbook
Alternative links
Stephen Bullen - FormFun

 

   

Last updated 28th April 2007

 
 
  Home | Charts | VBA Code | Fun Stuff
Newsgroups | Tips | Links | What's New | Book List
Contact | About
Microsoft® and Microsoft® Excel are registered trademarks of the Microsoft Corporation.
andypope.info is not associated with Microsoft. Copyright ©2007 Andy Pope