Question

我有一个MonthView的UserForm，当我点击指定范围的单元格时，它成功打开，this SO thread给了我基本的脚本。它起作用，但它似乎并没有将UserForm放在我期望的地方。

当我单击B3:C2000范围内的任何单元格时，以下是当前脚本（我已放置在特定工作表中）以打开UserForm：

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 - UserForm打开

这就是我所看到的：

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

Answer 1

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

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

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

问题4：为什么它似乎与UserForm的底部对齐而不是顶部？＆＃34; top＆＃34;的定义之间似乎存在差异？当谈到细胞（范围）与用户形态。单元格的顶部是从第一行开始测量的，而用户窗体的顶部似乎是从Excel应用程序的顶部开始测量的。换句话说，如果activecell.top和userform.top都等于144，它们将是屏幕上的不同位置。这是因为activecell的顶部是Excel电子表格中第一行的144个点，而userform的顶部是Excel应用程序顶部的144个点（即 - Excel窗口的顶部），这是更高的在屏幕上，因为起始点（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”框架/ border”来设置位置。

我花了几天时间寻找涵盖所有可能性的完整答案，并且在几乎所有情况下，将表单的位置设置为非常接近正确答案的仅是this one由nerv撰写，是this discussion在MSDN论坛上写的-显然，大部分功劳都归功于他。我将其与其他各种来源的信息和代码“合并”在一起，以避免硬编码的变量，使代码32bit和64bit兼容，并涵盖表格问题周围的神秘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）（对于偶数行则全部平滑）。如果有人能找出原因，请与我分享这个奥秘，因为我怀疑这是一个简单的取整问题...

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

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

2 个答案:

图纸模块代码

用户形式代码