如何让弹出窗体在单元格点击时显示?

如题所述

在 Excel VBA 中,要让弹出窗体的位置跟着鼠标点击的单元格位置显示,可以使用以下步骤:

    首先,创建一个 UserForm(窗体),并为其添加控件。

    在工作表模块(例如:Sheet1)中,添加一个 Worksheet_SelectionChange 事件。

    在该事件中,获取单元格的位置并设置 UserForm 的位置。

    下面是一个简单的示例代码:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

' 检查是否选中了单元格 A3
If Target.Address = "$A$3" Then

' 获取单元格右上角的位置
Dim cellTop As Single, cellLeft As Single
cellTop = Target.Top
cellLeft = Target.Left + Target.Width

' 设置 UserForm1(假设窗体名称为 UserForm1)的位置
With UserForm1
.StartUpPosition = 0 ' 设置为手动控制窗体的位置
.Top = cellTop
.Left = cellLeft
.Show ' 显示窗体
End With

End If

End Sub

这个示例代码会在点击 A3 单元格时显示 UserForm1,并使其左上角与 A3 单元格的右上角齐平。请确保将 "UserForm1" 替换为您实际创建的 UserForm 的名称。

…………

回复:

如果在滚动窗口时,需要让 UserForm 依然跟随单元格位置显示,可以通过获取滚动条的位置并根据滚动条的位置调整 UserForm 的位置。以下是一个调整后的示例代码:

在 ThisWorkbook 中添加以下代码,用于获取滚动条位置:

Private Type SCROLLINFO
cbSize As Long
fMask As Long
nMin As Long
nMax As Long
nPage As Long
nPos As Long
nTrackPos As Long
End Type

Private Declare Function GetScrollInfo Lib "user32" (ByVal hWnd As Long, ByVal n As Long, lpScrollInfo As SCROLLINFO) As Long
Private Const SIF_RANGE = &H1
Private Const SIF_PAGE = &H2
Private Const SIF_POS = &H4
Private Const SIF_TRACKPOS = &H10
Private Const SIF_ALL = SIF_RANGE + SIF_PAGE + SIF_POS + SIF_TRACKPOS
Private Const SB_HORZ = 0
Private Const SB_VERT = 1

Public Function GetScrollPos(ByVal hWnd As Long, ByVal nBar As Long) As Long
Dim si As SCROLLINFO
si.cbSize = Len(si)
si.fMask = SIF_POS
GetScrollInfo hWnd, nBar, si
GetScrollPos = si.nPos
End Function

然后,修改 Worksheet_SelectionChange 事件,使其考虑滚动条位置:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

' 检查是否选中了单元格 A3
If Target.Address = "$A$3" Then

' 获取单元格右上角的位置
Dim cellTop As Single, cellLeft As Single
cellTop = Target.Top
cellLeft = Target.Left + Target.Width

' 获取滚动条位置
Dim hWnd As Long
hWnd = Application.hWnd
Dim hScrollPos As Long, vScrollPos As Long
hScrollPos = GetScrollPos(hWnd, SB_HORZ)
vScrollPos = GetScrollPos(hWnd, SB_VERT)

' 考虑滚动条位置,设置 UserForm1(假设窗体名称为 UserForm1)的位置
With UserForm1
.StartUpPosition = 0 ' 设置为手动控制窗体的位置
.Top = cellTop - vScrollPos
.Left = cellLeft - hScrollPos
.Show ' 显示窗体
End With

End If

End Sub

这样,即使在滚动窗口时,UserForm 依然会跟随单元格 A3 的位置显示。

…………

回复:

这可能是由于 API 函数的声明不兼容所致。请尝试使用以下声明,看看是否可以解决问题:

将以下内容添加到 ThisWorkbook 模块:

#If VBA7 Then
Private Declare PtrSafe Function GetScrollInfo Lib "user32" Alias "GetScrollInfo" (ByVal hWnd As LongPtr, ByVal n As Long, lpScrollInfo As SCROLLINFO) As Long
Private Type SCROLLINFO
cbSize As Long
fMask As Long
nMin As Long
nMax As Long
nPage As Long
nPos As Long
nTrackPos As Long
End Type
#Else
Private Declare Function GetScrollInfo Lib "user32" Alias "GetScrollInfo" (ByVal hWnd As Long, ByVal n As Long, lpScrollInfo As SCROLLINFO) As Long
Private Type SCROLLINFO
cbSize As Long
fMask As Long
nMin As Long
nMax As Long
nPage As Long
nPos As Long
nTrackPos As Long
End Type
#End If

Private Const SIF_RANGE = &H1
Private Const SIF_PAGE = &H2
Private Const SIF_POS = &H4
Private Const SIF_TRACKPOS = &H10
Private Const SIF_ALL = SIF_RANGE + SIF_PAGE + SIF_POS + SIF_TRACKPOS
Private Const SB_HORZ = 0
Private Const SB_VERT = 1

Public Function GetScrollPos(ByVal hWnd As Long, ByVal nBar As Long) As Long
Dim si As SCROLLINFO
si.cbSize = Len(si)
si.fMask = SIF_POS
GetScrollInfo hWnd, nBar, si
GetScrollPos = si.nPos
End Function

这将使用条件编译指令(#If VBA7 Then)来确保在 32 位和 64 位 VBA 环境中都能正确声明 API 函数。

接下来,请确保在相应的工作表模块(例如 Sheet1)中添加之前提到的 Worksheet_SelectionChange 事件代码。

如果问题仍然存在,请检查是否在正确的模块中添加了相应的代码。如有需要,也可以尝试将 VBA 项目中的所有模块编译并查看是否存在其他编译错误。在 VBA 编辑器中,选择 "调试" 菜单,然后点击 "编译 VBA 项目"。

温馨提示:答案为网友推荐,仅供参考
相似回答
大家正在搜