CODEWITHSUNDEEP
excelvba
Trevor Eyre
Trevor Eyre

Reputation: 737

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

Upvotes: 4

Views: 5098

Answers (3)

Henrik Wahlberg
Henrik Wahlberg

Reputation: 1

The answer above from kadrleyn works great except if you use frozen rows or columns, then it offsets the form up and left similar to the height / width of the frozen columns it looks like. This nearly works/positions the form quite close, but not perfect:

With TopLeftPoint
    .X = ActiveWindow.PointsToScreenPixelsX(Alan.Left * _
    (PixelsPerPointX * (ActiveWindow.Zoom / 100))) * PointsPerPixelX
    .Y = ActiveWindow.PointsToScreenPixelsY(Alan.Top * _
    (PixelsPerPointY * (ActiveWindow.Zoom / 100))) * PointsPerPixelY
    If (Alan.Column > ActiveWindow.SplitColumn) Then
      .X = .X + ActiveWindow.SplitHorizontal
    End If
    If (Alan.row > ActiveWindow.SplitRow) Then
      .Y = .Y + ActiveWindow.SplitVertical
    End If
    
End With

` (So adding the two If's to the code from kadrleyn)

Upvotes: 0

kadrleyn
kadrleyn

Reputation: 384

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

enter image description here

Source codes , sample file link

Upvotes: 0

Umesh
Umesh

Reputation: 11

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

Upvotes: 1

Related Questions