【Excel VBA编程】鼠标滑动,文字“显形”:从屏幕像素到Word文本坐标的追踪术

2.1 操作步骤

• 打开你的.docm文档，通过word文档另存为.docm类型获取

• 按下 Alt + F11 快捷键，打开VBA编辑器

• 选择 “插入” -> “模块”，将文中代码复制粘贴到新模块中
• 回到Word文档窗口，通过“开发工具”“宏”，选择宏名“mainPro”运行

以上操作完成后，就可以通过移动鼠标位置获取word中的文字了。为了让用户有充足的操作时间，读取时间控制在5秒钟（Sleep 5000），可根据实际情况自行调整

' 在模块顶部声明API函数和自定义类型，兼容32位和64位系统#If VBA7 Then    Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long#Else    Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long#End IfPrivate Type POINTAPI    X As Long    Y As LongEnd Type' 声明必要的API函数，用于延时#If VBA7 Then    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)#Else    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)#End IfSub MainPro()    Dim endTime As Double    Dim durationSeconds As Long    durationSeconds = 20 ' 设置跟踪时长（秒）    endTime = Timer + durationSeconds    Do While Timer < endTime        Sleep 5000        GetObjectByMouse ' 调用函数        DoEvents ' 转让控制权，避免程序无响应    Loop    MsgBox "鼠标跟踪结束。"End SubSub GetObjectByMouse()    Dim lppt As POINTAPI    Dim res As Long    Dim objUnderMouse As Object    Dim resultText As String    ' 获取当前鼠标光标在屏幕上的位置    res = GetCursorPos(lppt)    ' 使用屏幕坐标，通过RangeFromPoint获取该点的对象    Set objUnderMouse = ActiveWindow.RangeFromPoint(lppt.X, lppt.Y)    ' 检查获取到的对象，并选中它    If Not objUnderMouse Is Nothing Then        If TypeName(objUnderMouse) = "Range" Then            ' 获取指向的文字            If objUnderMouse.Words.Count > 0 Then                resultText = "鼠标指向了: " & objUnderMouse.Words(1).Text            Else                resultText = "鼠标位置没有文字。"            End If        End If    End If    MsgBox "坐标(" & lppt.X & ", " & lppt.Y & "): " & resultTextEnd Sub