鼠标悬停超链接后选择单元格

Question

说明

我正在试验鼠标悬停事件。在一张纸上，我有以下布局：

在 A 列中，有 3 个命名范围：RegionOne 即 A2:A4 RegionTwo 即 A5:A7 和 RegionThree 即 A8:A10。这些范围名称在C1:C3 中列出。在D1:D3 我有以下公式：

=IFERROR(HYPERLINK(ChangeValidation(C1)),"RegionOne")（C1 在D2、D3 中更改为C2、C3）

单元格F1 是一个命名范围：NameRollover。单元格F2 是一个数据验证单元格，其中Allow: = 根据代码执行更改的源。

目的

当用户将鼠标滑过D1:D3 范围时，会发生以下情况：

1. 根据条件格式突出显示单元格
2. 单元格F1 (NameRollover) 更改为突出显示的单元格内容
3. 单元格F2 数据验证将源更改为与单元格F1 中的值匹配的命名范围
4. 单元格F2 填充了数据验证列表的第一个条目

这是通过在 Sheet1 上使用以下 Private Sub 来实现的：

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？欢迎所有建议。

Answer 1

除了上面的 Tim 和我的 cmets，当您通过 HYPERLINK 方法运行程序时，无法选择单元格。话虽如此，如果您有兴趣，我已经设法找到了替代方案。这不使用HYPERLINK 方法，而是完全依赖于两个鼠标API。 GetCursorPos API 和 SetCursorPos API。

逻辑

1. 找到鼠标光标位置。
2. 直接在鼠标光标下查找范围。
3. 格式化/更新/选择相关单元格。

优点：

1. 不依赖于从 UDF 中更新/格式化/选择单元格。
2. 无需辅助列 (Col D) 即可满足您的需求。
3. 如果需要，您也可以绕过F1 单元格，直接从C1:C3 中获取值。但是，在下面的示例中，我使用的是F1。

缺点：

1. 必须Start 和Stop 处理。
2. 当鼠标超出范围C1:C3时，可以看到轻微的屏幕闪烁。

测试条件

出于测试目的，我创建了一个示例工作表，如下所示

有两个表单控制按钮使用Assign Macro绑定到StartTracking()和StopTracking()

代码：

将其粘贴到模块中。我们不再需要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

行动中

示例文件

Mouse over Example

免责声明

我还没有完全测试过这个文件，可能有错误。在玩这个文件之前，请确保你已经关闭了所有重要的工作。