Position Userform differently for each ActiveCell clicked

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?

Wounded

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.

Quintanilla

quick and easy to test.......all Shapes including your UserForm can be position in the same way. – Mcshane

This does not work. When you scroll down and say the active cell is now in the middle of the page, the user form now populates all the way at the bottom. – Wounded

Scrolling down is not the same changing the ActiveCell via the Enter key or the arrow keys. – Mcshane

Very strange! I can't replicate what you are seeing. On my system (Win 7 / Excel 2007) If I click on F1, the Shape appears below it and to the left. If I scroll downwards, F1 moves off-screen, taking the Shape with it. – Mcshane

Ok I think I may have found it. If you merge, say 6 cells horizontally together, and then click on that cell does it change? Scroll down a little, click on the same cell, does the position change? – Wounded

I think you did find it! ........... it operates in a different fashion with merged cells. – Mcshane

That's no good!! Any alternate ideas? Have you tried my edited question above-- manipulate the activate sub with offset? It seems that functions the same way. – Wounded

figured it out! Instead of using (Target, Range()) you can say (Target, []) and insert the merged cells in the brackets. – Wounded

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

Primaveria

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

Ninepins

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

Katzen

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

Cholecalciferol