VBA 将用户窗体放在所选范围旁边答案

【问题标题】：VBA Place Userform Next to Selected RangeVBA 将用户窗体放在所选范围旁边
【发布时间】：2022-04-15 03:43:11
【问题描述】：

我需要在选定的单元格旁边放置一个用户窗体。这是我的代码。 Excel 2013。

在用户表单模块中：

Private rangePosition As Range 'Property passed to form to set position based on range

'Set userform position to right of range
Property Let PositionToRange(rangeInput As Range)
    Set rangePosition = rangeInput
    Me.Left = rangePosition.Left + rangePosition.Width + 30
    Me.Top = rangePosition.Top + Application.CommandBars("Ribbon").Height + 27
End Property

在标准模块中：

userform.PositionToRange = Selection '(or some specified range)
userform.Show

好的，太好了。所以起初这似乎起到了作用。但是，它似乎只在 Excel 首次加载时在标准视图中工作，前 30 行左右。但是，如果您尝试在第 4000 行甚至第 40 行上使用它，它会将用户窗体远离屏幕。 Excel 似乎没有考虑屏幕的位置。要明白我的意思，请尝试使用上面的代码在单元格 A1 旁边放置一个用户窗体。然后向下滚动，使 A1 不再出现在屏幕上并再次运行代码。它将用户窗体放在完全相同的位置，就好像您仍然在原始位置向上滚动一样。

除了range.Left 等之外，我是否可以使用其他属性来相对于屏幕上范围的位置放置用户表单？或者我是否需要做一些奇怪的巫毒废话，在考虑到地球的旋转力和与太阳的相对距离之后，找出滚动条的位置并找到单元格的相对位置？

哦，微软...

【问题讨论】：

cpearson.com/excel/FormPosition.htm
嗯，所以它确实需要一堆巫术，对吧？我希望它会比这更简单一些。幸好皮尔逊先生已经完成了所有这些工作，所以至少我不必这样做。
蒂姆，如果您想通过该链接发布答案，我会将问题标记为已回答。谢谢！
我不确定我是否将发布一个裸链接作为答案，所以我很乐意将其作为评论留下。

标签： excel vba

【解决方案1】：

您可以使用

调整表单滚动时的位置

ActiveWindow.VisibleRange.Top &
ActiveWindow.VisibleRange.Left

在所有情况下都可以使用它

Me.Left = ActiveCell.Left + ActiveCell.Width  - ActiveWindow.VisibleRange.Left
Me.Top = ActiveCell.Top  - ActiveWindow.VisibleRange.Top

【讨论】：

只要窗口最大化，效果就很好。

【解决方案2】：

通过声明 GetDeviceCaps 、 GetDC 、 ReleaseDC 功能，我将用户窗体重新定位在每个单击的旁边 activecell .（模板在 32 位和 64 位 Excel 版本中检查）

Type POINTAPI
X As Long
Y As Long
End Type
#If VBA7 Then
Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDc As LongPtr, ByVal nIndex As Long) As Long
Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hDc As LongPtr) As Long
Dim hDc As LongPtr
#Else
Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDc As Long, ByVal nIndex As Long) As Long
Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDc As Long) As Long
Dim hDc As Long
#End If
...

Source codes , sample file link

【讨论】：