vba 如何在活动单元格旁边对齐用户窗体？

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

提问by Trevor D

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

我有一个 MonthView 的用户窗体，当我在指定的单元格范围内单击时会打开它。这个 SO 线程给了我基本的脚本。它没有将用户窗体放在我期望的位置。

Here is the script (that I placed in a specific worksheet) to open the UserForm when I click any cell in range B3:C2000.

这是当我单击 range 中的任何单元格时打开用户窗体的脚本（我放置在特定工作表中）B3:C2000。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Set oRange = Range("B3:C2000")
    If Not Intersect(Target, oRange) Is Nothing Then
        frmCalendar.Show
        frmCalendar.Top = ActiveCell.Offset(0, 0).Top
        frmCalendar.Left = ActiveCell.Offset(0, 1).Left
    End If
End Sub

Question 1: I have the UserForm StartUpPosition property set to 0 - Manual- is this correct?

问题 1：我将 UserForm StartUpPosition 属性设置为0 - Manual- 这是否正确？

Question 2: When I click any cell in the specified range, for the first time after opening the workbook, the UserForm always opens in the far top left corner of the screen. Why?

问题 2：当我单击指定范围内的任何单元格时，第一次打开工作簿后，用户窗体总是在屏幕的最左上角打开。为什么？

Question 3: When I click any cell in the specified range, for any clicks after the first, the UserForm opens relative to the previous cell that was active, instead of the one I just clicked. How do I get it to open relative to the cell just clicked, instead of relative to the previous active cell?

问题 3：当我单击指定范围内的任何单元格时，对于第一次之后的任何单击，用户窗体将相对于上一个活动的单元格打开，而不是我刚刚单击的单元格。如何让它相对于刚刚点击的单元格打开，而不是相对于前一个活动单元格？

Question 4: Why does it appear to align the bottom of the UserForm instead of the top?

问题 4：为什么它看起来对齐 UserForm 的底部而不是顶部？

After I do the following steps:
1 - Click cell C15
2 - UserForm opens
3 - Close UserForm
4 - Click cell 16
5 - UserForm opens

在我执行以下步骤后：
1 - 单击单元格 C15
2 - 用户窗体打开
3 - 关闭用户窗体
4 - 单击单元格 16
5 - 用户窗体打开

This is what I see:

这是我看到的：

EDIT: Here is the result after implementing J. Garth's solution (and changing the Offset property to (0, 2):

编辑：这是实施 J. Garth 的解决方案后的结果（并将 Offset 属性更改为 (0, 2)：

采纳答案by J. Garth

Question 1: I have the UserForm StartUpPosition property set to 0 - Manual - is this correct?Yes, it's correct. In the code below, I am setting this property in the code.

问题 1：我将 UserForm StartUpPosition 属性设置为 0 - 手动 - 这是正确的吗？是的，它是正确的。在下面的代码中，我在代码中设置了这个属性。

Question 2: When I click any cell in the specified range, for the first time after opening the workbook, the UserForm always opens in the far top left corner of the screen. Why?I think the answer to this is somewhat related to question #3. That would seem to be a default location for the form to open in. The way you have the code now, trying to set the form top and left coordinates in the Worksheet_SelectionChangeevent is not working because the coordinates are never actually getting set. The setting of the coordinates needs to be moved to the userform initialization event.

问题 2：当我单击指定范围内的任何单元格时，第一次打开工作簿后，用户窗体总是在屏幕的最左上角打开。为什么？我认为这个答案与问题#3 有点相关。这似乎是表单打开的默认位置。您现在拥有代码的方式，尝试在Worksheet_SelectionChange事件中设置表单顶部和左侧坐标是行不通的，因为坐标实际上从未设置过。坐标的设置需要移到用户窗体初始化事件中。

Question 3: When I click any cell in the specified range, for any clicks after the first, the UserForm opens relative to the previous cell that was active, instead of the one I just clicked. How do I get it to open relative to the cell just clicked, instead of relative to the previous active cell?This problem is also related to the code being in the wrong place. As noted above, the coordination setting needs to take place in the userform initialization event. As to why it's referencing the previous active cell, my guess would be that the active cell doesn't actually get changed until after the worksheet selection change event completes. So since you are trying to set the coordinates within this event (i.e. - before the event finishes), you are getting the previously active cell. Again, moving the code to the correct location fixes this issue.

问题 3：当我单击指定范围内的任何单元格时，对于第一次之后的任何单击，用户窗体将相对于上一个活动的单元格打开，而不是我刚刚单击的单元格。如何让它相对于刚刚点击的单元格打开，而不是相对于前一个活动单元格？这个问题也与代码位置错误有关。如上所述，协调设置需要在用户表单初始化事件中进行。至于为什么它引用前一个活动单元格，我的猜测是活动单元格在工作表选择更改事件完成之前实际上不会更改。因此，由于您尝试在此事件中设置坐标（即 - 在事件完成之前），您将获得先前活动的单元格。同样，将代码移动到正确的位置可以解决此问题。

Question 4: Why does it appear to align the bottom of the UserForm instead of the top?There appears to be a difference between the definition of "top" when it comes to cells (ranges) vs userforms. The top of the cell is measured from the first row whereas the top of the userform seems to be measured from the top of the Excel application. So in over words, if activecell.top and userform.top are both equal to 144, they will be different locations on the screen. This is because the top of activecell is 144 points down from the first row in the Excel spreadsheet while the top of the userform is 144 points down from the top of the Excel application (i.e. - the top of the Excel window), which is higher on the screen because the starting point (top of the Excel window) is higher than the starting point for activecell.top (first row in the spreadsheet). We can adjust for that by adding the height of the userform plus the height of the active cell to the top coordinate.

问题 4：为什么它看起来对齐 UserForm 的底部而不是顶部？就单元格（范围）和用户表单而言，“顶部”的定义似乎有所不同。单元格的顶部是从第一行开始测量的，而用户表单的顶部似乎是从 Excel 应用程序的顶部开始测量的。所以总而言之，如果 activecell.top 和 userform.top 都等于 144，它们将在屏幕上处于不同的位置。这是因为 activecell 的顶部距 Excel 电子表格中的第一行向下 144 点，而用户窗体的顶部距 Excel 应用程序的顶部（即 - Excel 窗口的顶部）向下 144 点，这是更高的因为起点（Excel 窗口的顶部）高于 activecell.top 的起点（电子表格中的第一行）。

Sheet module code

工作表模块代码

Private Sub Worksheet_SelectionChange(ByVal target As Range)

    Dim oRange As Range

    Set oRange = Range("B3:C2000")
    If Not Intersect(target, oRange) Is Nothing Then
        frmCalendar.Show
    End If

End Sub

Userform code

用户表单代码

Private Sub UserForm_Initialize()

    With Me
        .StartUpPosition = 0
        .Top = ActiveCell.Top + ActiveCell.Height + .Height
        .Left = ActiveCell.Offset(0, 1).Left
    End With

End Sub

回答by Yin Cognyto

The answer provided by J. Garth did a greatjob 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.

J. Garth 提供的答案在解释事情方面做得很好，但是，正如我在评论中提到的，虽然它适用于这种特定情况，但在其他各种情况下却失败了（例如缩放级别更改、目标的拆分/冻结窗格范围超出工作表的初始可见范围），更不用说它在设置位置时没有考虑标题行/列（也受缩放级别更改的影响）和表单周围的 3D“框架/边框” .

I spent a few days looking for a complete answer to cover all possibilities, and the onlyone that set a form's position very close to the correct one in almost all scenarios was this oneby nerv, written as a result of this discussionon 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.

我花了几天寻找一个完整的答案，包括所有的可能性，而只有一个，在几乎所有情况下将窗体的位置非常接近正确的是这一个由NERV，写成的结果，这种讨论在MSDN论坛- 显然，大部分功劳归功于他。我将它与来自其他各种来源的其他信息和代码“合并”，以避免硬编码变量，使代码兼容 32 位和 64 位，并覆盖表单问题周围的神秘 3D 框架。

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 exactlyon 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...

上面的大部分内容都是不言自明的，并且它们完美无缺 - 至少从我能够测试的内容来看。仍然困扰我有点唯一（是的，我知道，但我是一个完美主义者）是由于某种原因，形式帧不是正好所需的细胞网格线（即它的1px的降低）为奇数行（虽然对于偶数编号，一切都很顺利）。如果有人能弄清楚原因，请与我分享这个谜团，因为我怀疑这是一个简单的四舍五入问题......

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 verticaloffsetinpointsvariable to adjust the curious (but this time consistent) "1px lower than expected" vertical glitch that I couldn't find an explanation for (yet).

编辑：今天，在使用计时器时，我想出了如何避免上面出现的奇数行和偶数行之间的差异：这只是声明点值和输出（以及缩​​放比率）As Double（即浮动-点数）而不是As Long（即整数）。我犯了一个愚蠢的错误 - 我已经正确编辑了代码以更正它。我添加了一个verticaloffsetinpoints变量来调整奇怪的（但这次是一致的）“比预期低 1px”的垂直故障，我（还）找不到解释。