鼠标悬停超链接后选择单元格
描述
我正在试验鼠标悬停事件。在一张纸上，我有以下布局：
在塔A中，有3个命名范围：RegionOne这是A2:A4 RegionTwo这是A5:A7和RegionThree它是A8:A10。这些范围名称列在C1:C3. 在D1:D3我有以下公式：
=IFERROR(HYPERLINK(ChangeValidation(C1)),"RegionOne") （C1更改为C2，C3在D2，D3）
单元格F1是一个命名范围：NameRollover。单元格F2是数据验证单元格，其中Allow:= 源根据代码执行而变化。
目的
当用户将鼠标滚动到范围上时D1:D3，会发生以下情况：
- 根据条件格式突出显示单元格
- 单元格
F1(NameRollover) 更改为突出显示的单元格内容 - 单元格
F2数据验证将源更改为与单元格中的值匹配的命名范围F1 - 单元格
F2填充数据验证列表的第一个条目
这是通过Private Sub在 Sheet1 上使用以下内容来实现的：
Private Sub Worksheet_Change(ByVal Target As Range)
Dim MyList As String
If Not Intersect(Range("F1"), Target) Is Nothing Then
With Sheet1.Range("F2")
.ClearContents
.Validation.Delete
MyList = Sheet1.Range("F1").Value
.Validation.Add Type:=xlValidateList, Formula1:="=" & MyList
End With
Sheet1.Range("F2").Value = Sheet1.Range(MyList).Cells(1, 1).Value
End If
End Sub
并通过使用以下功能（在标准模块中）
Public Function ChangeValidation(Name As Range)
Range("NameRollover") = Name.Value
End Function
一切正常，除了……
我希望在翻转操作之后，数据验证单元格 ( F2) 成为“活动”单元格。目前，用户必须选择该单元格，除非它已经是活动单元格。 为了尝试实现这一点，我在Private Sub之前的末尾尝试了以下各项End If：
Application.Goto Sheet1.Range("F2")
Sheet1.Range("F2").Select
Sheet1.Range("F2").Activate
没有一个有效。
题
如何在 Private Sub 执行结束时将焦点转移到我选择的单元格 - 在这种情况下F2？欢迎提出所有建议。
回答
除了上述蒂姆和我的评论之外，当您通过HYPERLINK方法运行过程时无法选择单元格。话虽如此，如果您有兴趣，我已经设法找到了替代方案。这不使用该HYPERLINK方法，而是完全依赖于两个鼠标 API。GetCursorPos API 和SetCursorPos API。
逻辑
- 找到鼠标光标位置。
- 直接在鼠标光标下找到范围。
- 格式化/更新/选择相关单元格。
优点：
- 不依赖于从 UDF 内部更新/格式化/选择单元格。
- 无需辅助列（Col D）即可执行您想要的操作。
F1如果需要，您也可以绕过单元格并直接从C1:C3. 但是在下面的示例中，我使用的是F1.
缺点：
- 一个必须
Start和Stop过程。 - 当鼠标超出范围时，可以看到轻微的屏幕闪烁
C1:C3。
测试条件
出于测试目的，我创建了一个示例工作表，如下所示
有两个表单控件按钮绑定StartTracking()并StopTracking()使用Assign Macro
代码：
将其粘贴到模块中。我们不再需要这个Worksheet_Change事件了。
Option Explicit
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Type POINTAPI
Xcoord As Long
Ycoord As Long
End Type
Dim StopProcess As Boolean
Dim ws As Worksheet
'~~> Start Tracking
Sub StartTracking()
StopProcess = False
TrackMouse
End Sub
'~~> Stop Tracking
Sub StopTracking()
StopProcess = True
End Sub
Sub TrackMouse()
Set ws = Sheet1
'~~> This is the range which has the names of named range
Dim trgtRange As Range
Set trgtRange = ws.Range("C1:C3")
Dim rng As Range
Dim mouseCord As POINTAPI
Do
'~~> Get the current cursor location and try to find the
'~~> range under the cursor
GetCursorPos mouseCord
Set rng = Nothing
Set rng = GetRangeUnderMousePosition(mouseCord.Xcoord, mouseCord.Ycoord)
'~~> Check if the cursor is above C1:C3
If Not rng Is Nothing Then
If Not Intersect(trgtRange, rng) Is Nothing Then
UpdateAndFormat rng
Application.Cursor = xlDefault
End If
End If
DoEvents '<~~ Do not uncomment or remove this
If StopProcess = True Then Exit Do
Loop
End Sub
'~~> Get the range under the cursor
Function GetRangeUnderMousePosition(x As Long, y As Long) As Range
On Error Resume Next
Set GetRangeUnderMousePosition = ActiveWindow.RangeFromPoint(x, y)
On Error GoTo 0
End Function
'~~> Update and format cells F1/F2
Private Sub UpdateAndFormat(rng As Range)
ws.Range("NameRollover").Value = rng.Value2
With ws.Range("F2")
.ClearContents
.Validation.Delete
.Validation.Add Type:=xlValidateList, Formula1:="=" & _
ws.Range("NameRollover").Value2
.Value = ws.Range(ws.Range("NameRollover").Value2).Cells(1, 1).Value
Application.ScreenUpdating = False '<~~ To minimize showing the busy cursor
.Select
Application.ScreenUpdating = True
'~~> Optional. Feel free to uncomment the below
'~~> Move the cursor over cell F2. If it stays over C1:C3 then you will
'~~> get busy cursor icon
'SetCursorPos _
ActiveWindow.ActivePane.PointsToScreenPixelsX(.Left + (.Width / 2)), _
ActiveWindow.ActivePane.PointsToScreenPixelsY(.Top + (.Height / 2))
End With
End Sub
在行动
示例文件
鼠标悬停示例
免责声明
我还没有完全测试这个文件，可能有错误。在播放此文件之前，请确保您已关闭所有重要工作。