Resize Userforms at Runtime

Jun 06, 2007 14:11

Sometimes it'd be useful if one could resize their own userforms at runtime. To enable such functionality, it needs a bit of coding work:

At first, create a resize handle on your userform (for this example, let's assume the form has the name Userform1)
Add a Label and set the following properties:
  • Name: ResizeHandle
  • Height: 15
  • Width: 15
  • Font:
    • Name: Marlett
    • Size: 14
  • Caption: o
  • BackStyle: fmBackStyleTransparent
  • BorderStyle: fmBorderStyleNone
  • MousePointer: fmMousePointerSizeNWSE
  • Top: This needs a bit of calculation, it's the InsideHeight of the userform minus the height of the label. To calculate it, enter in the immediate window:
    Print Userform1.InsideHeight - Userform1.ResizeHandle.Height
  • Left: Analogue to top, calculate as follows:
    Print Userform1.InsideWidth - Userform1.ResizeHandle.Width


Now add the following code to the code section of the userform:

Option Explicit

'Minimum width that the form should keep
Const MinWidth As Single = 138 'of course use your own userform
'width instead of 138 here
'Minimum height that the form should keep
Const MinHeight As Single = 103 'of course use your own userform
'height instead of 103 here
'Store the cursor position when starting with resizing
Private myTopResizePos As Single
Private myLeftResizePos As Single

Private Sub ResizeHandle_MouseDown(ByVal Button As Integer,
ByVal Shift As Integer,
ByVal X As Single,
ByVal Y As Single)
'save initial cursor position
If Button = 1 Then
myLeftResizePos = X
myTopResizePos = Y
End If
End Sub

Private Sub ResizeHandle_MouseMove(ByVal Button As Integer,
ByVal Shift As Integer,
ByVal X As Single,
ByVal Y As Single)
Dim myX As Single
Dim myY As Single

If Button = 1 Then
With Me
'compute size change
myX = X - myLeftResizePos
myY = Y - myTopResizePos
'make sure form won't get too small
If .Width + myX < MinWidth Then myX = MinWidth - .Width
If .Height + myY < MinHeight Then myY = MinHeight - .Height
'adapt size of form
.Width = .Width + myX
.Height = .Height + myY
'adapt controls that should be affected by the resize
'e.g. make textbox longer
.TextBox1.Width = .TextBox1.Width + myX
'or move checkbox so it stays at the right side
.CheckBox1.Left = .CheckBox1.Left + myX

'make sure the resize handle remains fixed in
'the bottom right hand corner
.ResizeHandle.Left = .InsideWidth - .ResizeHandle.Width
.ResizeHandle.Top = .InsideHeight - .ResizeHandle.Height
End With
End If
End Sub
If you want to enable resizing only for one dimension, adapt the above as follows:
Only resize Width:
  • Set Mousepointer for the resize handle label = fmMousePointerWE
  • Leave out all code lines that deal with Y/Height
Only resize Height:
  • Set Mousepointer for the resize handle label = fmMousePointerNS
  • Leave out all code lines that deal with X/Width

word, userform, excel, ms_office, resize, vba

Previous post Next post
Up