Userform Resizing

[Jaye7]

Is it possible to have a userform resize like when you click on the bottom corner of a picture and drag it to resize to whatever size you want it to be.

 

[Jaye7]

I found a solution at the following.

http://www.andypope.info/vba/resizeform.htm

 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 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 
          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 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