Select 鼠标悬停超链接后的单元格

Question

描述

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

在列 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 范围内时，会发生以下情况：

根据条件格式突出显示单元格
单元格 F1 (NameRollover) 更改为突出显示的单元格内容
单元格 F2 数据验证将源更改为与单元格 F1
单元格 F2 填充了数据验证列表的第一个条目

这是通过在工作表 1 上使用以下 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) 成为“活动”单元格。目前，用户必须 select 该单元格，除非它已经是活动单元格。 为了尝试实现这一目标，我在 End If 之前的 Private Sub 末尾尝试了以下各项：

Application.Goto Sheet1.Range("F2")
Sheet1.Range("F2").Select
Sheet1.Range("F2").Activate

None 其中有效。

问题

如何让焦点在 Private Sub 执行结束时转移到我选择的单元格 - 在本例中为 F2？欢迎所有建议。

Answer 1

根据 Tim 和我上面的评论，当您通过 HYPERLINK 方法运行一个过程时，不可能 select 一个单元格。话虽如此，如果您有兴趣，我已经找到了替代方案。这不使用 HYPERLINK 方法，而是完全依赖于两个鼠标 API。 GetCursorPos API and SetCursorPos API.

逻辑

找到鼠标光标位置。
找到鼠标光标正下方的范围。
Format/Update/Select 个相关单元格。

优点：

不依赖于 updating/formatting/Selecting 来自 UDF 内部的单元格。
无需辅助列 (Col D) 即可完成您想要的操作。
如果需要，您也可以绕过 F1 单元格，直接从 C1:C3 中获取值。在下面的示例中，我使用的是 F1.

缺点：

必须Start和Stop这个过程。
当鼠标超出范围时，可以看到轻微的屏幕闪烁 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

免责声明

我还没有完全测试这个文件，可能有错误。请确保在播放此文件之前已关闭所有重要工作。

Select 鼠标悬停超链接后的单元格

Select Cell after Mouse-rollover Hyperlinks

excel

vba

mouseover