Position Userform differently for each ActiveCell Clicked

问题

I have a UserForm of a MonthView and DTPicker that will populate when certain cells are clicked. I have the form positioned for directly below the first cell, but would like it to populate right under each active cell that I tell it to activate on. My current activate code to position the user form is:

Private Sub UserForm_Activate()
    With frmCalendar
        .Top = Application.Top + 340
        .Left = Application.Left + 330
    End With
End Sub

and my worksheet selection change code, which will launch the userform upon certain cell clicks is:

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 out there 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. Do I need to add code to the worksheet sub or the activate sub?? What code would that be?

Thanks.

EDIT:

I have just changed the Activate Sub code to

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 actually moves further down but stays the same distance to the right. This it still is messy. There is no way to position this form directly below the ActiveCell using these methods?

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

回答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

回答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