drewzilla652
New Member
- Joined
- Oct 19, 2010
- Messages
- 19
I found some code to add a sizing handle to a userform. But, I also have scrollbars on this userform. When I use the sizing handle, it works great. But, when I scroll, the sizing handle moves also.
I'm looking for code to always keep the sizing handle in the lower right hand corner....even after scrolling.
I was thinking of using a Userform_Scroll event to move it, but can't seem to figure the code, as in:
Private Sub UserForm_Scroll(ByVal ActionX As MSForms.fmScrollAction, ByVal ActionY As MSForms.fmScrollAction, ByVal RequestDx As Single, ByVal RequestDy As Single, ByVal ActualDx As MSForms.ReturnSingle, ByVal ActualDy As MSForms.ReturnSingle)
Here is the code related to moving the sizing handle when selecting it. Thanks SO much in advance!
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
bb = m_objResizer.Height
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
I'm looking for code to always keep the sizing handle in the lower right hand corner....even after scrolling.
I was thinking of using a Userform_Scroll event to move it, but can't seem to figure the code, as in:
Private Sub UserForm_Scroll(ByVal ActionX As MSForms.fmScrollAction, ByVal ActionY As MSForms.fmScrollAction, ByVal RequestDx As Single, ByVal RequestDy As Single, ByVal ActualDx As MSForms.ReturnSingle, ByVal ActualDy As MSForms.ReturnSingle)
Here is the code related to moving the sizing handle when selecting it. Thanks SO much in advance!
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
bb = m_objResizer.Height
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