如何在活动单元格旁边正确对齐UserForm？

Question

我有一个MonthView的UserForm,当我点击指定范围的单元格时成功打开,这个SO线程给了我基本的脚本.它的功能,但似乎并没有把UserForm放在我期望的地方.

以下是当我单击范围内的任何单元格时打开UserForm的当前脚本(我已放置在特定工作表中)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

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

问题2:当我单击指定范围内的任何单元格时,在打开工作簿后第一次,UserForm始终在屏幕的最左上角打开.为什么？

问题3:当我单击指定范围内的任何单元格时,对于第一个单元格之后的任何单击,UserForm将相对于上一个处于活动状态的单元格打开,而不是我刚刚单击的单元格.如何让它相对于刚刚单击的单元格打开,而不是相对于之前的活动单元格？

问题4:为什么它似乎与UserForm的底部对齐而不是顶部？

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

这就是我所看到的:

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

Answer 1

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

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

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

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

工作表模块代码

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

用户表单代码

Private Sub UserForm_Initialize()

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

End Sub

Answer 2

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

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

工作表代码

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    UserForm1.Show
End Sub

用户表单代码

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

模块代码

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

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

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