How do I align a UserForm next to the active cell?

Question

I have a UserForm of a MonthView that opens when I click in the specified range of cells. This SO thread gave me the basic script. It doesn\'t put the UserForm where I expec

Answer 1

The answer provided by J. Garth did a great job explaining things, however, as I mentioned in my comments, while it works for this specific situation, it fails on various other scenarios (e.g. zoom level changes, split/frozen panes with the target range outside the sheet's initial visible range), not to mention that it doesn't take into account the header row/column (that are also subject to zoom level changes) and the 3D "frame/border" around a form when setting the position.

I spent a few days looking for a complete answer to cover all possibilities, and the only one that set a form's position very close to the correct one in almost all scenarios was this one by nerv, written as a result of this discussion on MSDN forums - most of the credit goes to him, obviously. I "merged" it with other bits of information and code from various other sources in order to avoid hardcoded variables, make the code 32bit and 64bit compatible and cover the mysterious 3D frame around the form issue.

Sheet code

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    UserForm1.Show
End Sub

Userform code

Private Sub UserForm_Initialize()
  Dim pointcoordinates As pointcoordinatestype, horizontaloffsetinpoints As Double, verticaloffsetinpoints As Double
    With Me
        horizontaloffsetinpoints = (.Width - .InsideWidth) / 2
        verticaloffsetinpoints = 1 
        Call GetPointCoordinates(ActiveCell, pointcoordinates)
        .StartUpPosition = 0
        .Top = pointcoordinates.Top - verticaloffsetinpoints
        .Left = pointcoordinates.Left - horizontaloffsetinpoints
    End With
End Sub

Module code

Private Const LOGPIXELSX = 88
Private Const LOGPIXELSY = 90
Public Type pointcoordinatestype
    Left As Double
    Top As Double
    Right As Double
    Bottom As Double
End Type
Private pixelsperinchx As Long, pixelsperinchy As Long, pointsperinch As Long, zoomratio As Double
#If VBA7 And Win64 Then
    Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hdc As LongPtr, ByVal nIndex As Long) As Long
    Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
    Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hdc As LongPtr) As Long
#Else
    Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
    Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
#End If

Private Sub ConvertUnits()
  Dim hdc As LongPtr
    hdc = GetDC(0)
    pixelsperinchx = GetDeviceCaps(hdc, LOGPIXELSX) ' Usually 96
    pixelsperinchy = GetDeviceCaps(hdc, LOGPIXELSY) ' Usually 96
    ReleaseDC 0, hdc
    pointsperinch = Application.InchesToPoints(1)   ' Usually 72
    zoomratio = ActiveWindow.Zoom / 100
End Sub

Private Function PixelsToPointsX(ByVal pixels As Long) As Double
    PixelsToPointsX = pixels / pixelsperinchx * pointsperinch
End Function

Private Function PixelsToPointsY(ByVal pixels As Long) As Double
    PixelsToPointsY = pixels / pixelsperinchy * pointsperinch
End Function

Private Function PointsToPixelsX(ByVal points As Double) As Long
    PointsToPixelsX = points / pointsperinch * pixelsperinchx
End Function

Private Function PointsToPixelsY(ByVal points As Double) As Long
    PointsToPixelsY = points / pointsperinch * pixelsperinchy
End Function

Public Sub GetPointCoordinates(ByVal cellrange As Range, ByRef pointcoordinates As pointcoordinatestype)
  Dim i As Long
    ConvertUnits
    Set cellrange = cellrange.MergeArea
    For i = 1 To ActiveWindow.Panes.Count
        If Not Intersect(cellrange, ActiveWindow.Panes(i).VisibleRange) Is Nothing Then
            pointcoordinates.Left = PixelsToPointsX(ActiveWindow.Panes(i).PointsToScreenPixelsX(cellrange.Left))
            pointcoordinates.Top = PixelsToPointsY(ActiveWindow.Panes(i).PointsToScreenPixelsY(cellrange.Top))
            pointcoordinates.Right = pointcoordinates.Left + cellrange.Width * zoomratio
            pointcoordinates.Bottom = pointcoordinates.Top + cellrange.Height * zoomratio
            Exit Sub
        End If
    Next
End Sub

Most of the things above are self-explanatory, and they work flawlessly - at least from what I've been able to test. The only thing that still bothers me a bit (yeah, I know, but I'm a perfectionist) is that for some reason the form frame isn't exactly on the desired cell gridline (i.e. it's 1px lower) for odd numbered rows (while it all goes smooth for even numbered ones). If anyone can figure out why, please share this mystery with me, as I doubt that it's a simple rounding issue...

EDIT: Today, while working with Timers, I figured out how to avoid the differences between odd and even numbered rows that occured above: it was just a matter of declaring point values and outputs (as well as the zoom ratio) As Double (i.e. floating-point numbers) instead of As Long (i.e. integers). Silly mistake from my part - I've properly edited the code to correct it. I've added a verticaloffsetinpoints variable to adjust the curious (but this time consistent) "1px lower than expected" vertical glitch that I couldn't find an explanation for (yet).