Userform Resizing

Jaye7

Well-known Member
Joined
Jul 7, 2010
Messages
1,060
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.
 

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.
I found a solution at the following.

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



Code:
 Option Explicit
Code:
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
 
Upvote 0

Forum statistics

Threads
1,213,562
Messages
6,114,322
Members
448,564
Latest member
ED38

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top