vba 为每个单击的 ActiveCell 定位不同的用户窗体

Position Userform differently for each ActiveCell Clicked

提问by Sinister Swan

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:

我有一个 MonthView 和 DTPicker 的用户窗体，它会在单击某些单元格时填充。我将表单定位在第一个单元格的正下方，但希望它填充在我告诉它激活的每个活动单元格的正下方。我当前用于定位用户表单的激活代码是：

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?

我知道有加载项可以帮助做到这一点，但我想弄清楚如何在不使用加载项的情况下将用户表单放在上面提到的单元格（H10、H14、H15）的正下方。我是否需要将代码添加到工作表子或激活子？那会是什么代码？

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?

这将它稍微移动到单元格的下方和右侧，但是当我在另一个单元格上尝试它时，它实际上进一步向下移动，但与右侧保持相同的距离。这个还是乱七八糟的。有没有办法使用这些方法将此表单直接放置在 ActiveCell 下方？

采纳答案by Gary's Student

You are using the correct Event macro. I placed a TextBox in the worksheet and with this macro

您正在使用正确的事件宏。我在工作表中放置了一个 TextBox 并使用此宏

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.

我可以让 TextBox 移动到右侧和活动单元格的正下方。

回答by dcromley

I found http://www.vbaexpress.com/forum/archive/index.php/t-22038.htmland developed this which I've used:

我找到了http://www.vbaexpress.com/forum/archive/index.php/t-22038.html并开发了我使用过的这个：

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

回答by Harry S

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

回答by J. Garth

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

如何正确对齐活动单元格旁边的用户窗体