'VBA Place Userform Next to Selected Range
I need to place a userform next to a selected cell. Here's my code. Excel 2013.
In the userform module:
Private rangePosition As Range 'Property passed to form to set position based on range
'Set userform position to right of range
Property Let PositionToRange(rangeInput As Range)
Set rangePosition = rangeInput
Me.Left = rangePosition.Left + rangePosition.Width + 30
Me.Top = rangePosition.Top + Application.CommandBars("Ribbon").Height + 27
End Property
In a standard module:
userform.PositionToRange = Selection '(or some specified range)
userform.Show
Okay, great. So at first this seemed to do the trick. However, it only seems to work in the standard view when Excel first loads, with the first 30 rows or so. However, if you try to use it on, say, row 4000, or even 40, it places the userform WAY off the screen. Excel doesn't seem to take the position of the screen into account. To see what I mean, try using the code above to place a userform next to cell A1. Then scroll down so A1 is no longer on the screen and run the code again. It puts the userform in exactly the same place, as if you were still scrolled up in the original position.
Is there an attribute I can use other than range.Left
, etc to place the userform relative to where the range is on the screen? Or do I need to do some weird voodoo crap where I figure out the position of the scroll bar and find the position of the cell relative to that, after factoring in the rotational force of the earth and relative distance from the sun, of course?
Oh, Microsoft...
Solution 1:[1]
You can adjust the position of the form when it is scrolled by using the
ActiveWindow.VisibleRange.Top &
ActiveWindow.VisibleRange.Left
Use this it will work in all cases
Me.Left = ActiveCell.Left + ActiveCell.Width - ActiveWindow.VisibleRange.Left
Me.Top = ActiveCell.Top - ActiveWindow.VisibleRange.Top
Solution 2:[2]
By declaring the GetDeviceCaps , GetDC , ReleaseDC functions , I repositioned the userform next to each the clicked activecell .(The template is checked in 32-bit and 64-bit Excel versions)
Type POINTAPI
X As Long
Y As Long
End Type
#If VBA7 Then
Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDc As LongPtr, ByVal nIndex As Long) As Long
Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hDc As LongPtr) As Long
Dim hDc As LongPtr
#Else
Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDc As Long, ByVal nIndex As Long) As Long
Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDc As Long) As Long
Dim hDc As Long
#End If
...
Sources
This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.
Source: Stack Overflow
Solution | Source |
---|---|
Solution 1 | Getz |
Solution 2 | kadrleyn |