Position Userform differently for each ActiveCell clicked - vba

Question

I have a UserForm of a MonthView and DTPicker that will populate when certain cells are clicked.
I have the form positioned directly below the first cell.
I would like it positioned right below each active cell that I tell it to activate on.
My activate code to position the userform:
Private Sub UserForm_Activate()
With frmCalendar
.Top = Application.Top + 340
.Left = Application.Left + 330
End With
End Sub
My worksheet selection change code, which will launch the userform upon certain cell clicks:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Application.Intersect(Target, Range("H10,H15")) Is Nothing Then
frmCalendar.Show
End If
End Sub
I know there are add-ins that help do this, but I'd like to figure out how to position the user form right below the cells mentioned above (H10, H14, H15) without using an add-in.
I changed the Activate Sub code
Private Sub UserForm_Activate()
With frmCalendar
.Top = ActiveCell.offset(31).Top
.Left = ActiveCell.offset(1).Left
End With
End Sub
This moves it slightly below and slightly to the right of the cell, but when I try it on another cell is moves further down but stays the same distance to the right. This still is messy.
Is there no way to position this form directly below the ActiveCell using these methods?

Answer 1

You are using the correct Event macro. I placed a TextBox in the worksheet and with this macro
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim s As Shape
Set s = ActiveSheet.Shapes(1)
s.Top = ActiveCell.Offset(1, 1).Top
s.Left = ActiveCell.Offset(1, 1).Left
End Sub
I can get the TextBox to move just to the right and just below the activecell.

Answer 2

I found http://www.vbaexpress.com/forum/archive/index.php/t-22038.html and developed this which I've used:
Sub showUform(iRow&, iCol&)
Dim x11!, y11!
ActiveSheet.Cells(iRow, iCol).Select
x11 = ActiveWindow.PointsToScreenPixelsX(ActiveSheet.Cells(1, 1))
y11 = ActiveWindow.PointsToScreenPixelsY(ActiveSheet.Cells(1, 1))
UserForm1.Left = x11 + ActiveSheet.Cells(iRow, iCol).Left
UserForm1.Top = y11 + ActiveSheet.Cells(iRow, iCol).Top
UserForm1.Show
End Sub

Answer 3

Sub FormToActCell(UF As Object, Optional RaD$ = "ACAD", Optional Topw% = 102, _
Optional TopH% = -120)
' form to Active cell or RaD as range address ,offsets topW topH
Dim Px&, Py&, Zoomp!
If RaD = "ACAD" Then RaD = ActiveCell.Address
Set CellToRange = Range(RaD)
With CellToRange ' get point about object to
Px = (.Left + .Width * Topw / 100)
Py = (.Top + .Height * TopH / 100)
End With
Zoomp = ActiveWindow.Zoom / 100
With UF ' assuming screen as normal pts to pix of 3:4
.Left = Px * Zoomp + ActiveWindow.PointsToScreenPixelsX(0) * 0.75
.Top = Py * Zoomp + ActiveWindow.PointsToScreenPixelsY(0) * 0.75
End With
End Sub

Answer 4

Please see the answer I provided to this question as I believe this question is the same.
How do I properly align UserForm next to active cell

Answer 5

by declaring the GetDeviceCaps , GetDC , ReleaseDC functions , I repositioned the userform next to each the clicked activecell .
(I checked the codes in 32-bit and 64-bit versions of Excel)
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
...
Source of codes & sample file