vba - 使用箭头键导航时将鼠标指针移动到事件单元格的中心

Question

当使用箭头键从一个单元格导航到另一个单元格时，我试图让鼠标指针移动到所选单元格的中心

在 Excel 2010 中，以下解决方案完美运行

Public Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

SetCursorPos _
    ActiveWindow.ActivePane.PointsToScreenPixelsX(Target.Left + (Target.Width / 2)), _
    ActiveWindow.ActivePane.PointsToScreenPixelsY(Target.Top + (Target.Height / 2))

End Sub

然而在 Excel 2003 ActiveWindow.ActivePane没有 PointsToScreenPixelsX和 PointsToScreenPixelsY方法。所以我试图找到另一种解决方案，例如下面的解决方案。 X 轴工作正常，但 Y 轴不行。

Public Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

SetCursorPos _
    ActiveWindow.Application.ActiveWindow.PointsToScreenPixelsX((Target.Left + (Target.Width / 2)) / 0.75), _
    ActiveWindow.Application.ActiveWindow.PointsToScreenPixelsY((Target.Top + (Target.Height / 2)) / 0.75)

End Sub

我希望不管分辨率等如何都能正常工作。有什么想法吗？

Answer 1

这应该适用于旧版本的 Excel。它很笨重，但它可以完成工作。

Declare Function SetCursorPos Lib "user32" _
   (ByVal x As Long, ByVal y As Long) As Long
Declare Function GetDC Lib "user32" ( _
  ByVal hwnd As Long) As Long
Declare Function ReleaseDC Lib "user32" ( _
  ByVal hwnd As Long, ByVal hDC As Long) As Long
Declare Function GetDeviceCaps Lib "gdi32" ( _
  ByVal hDC As Long, ByVal nIndex As Long) As Long

Sub MoveMouseToRange(R As Range)
Static lDPI&(1), lDC&

If lDPI(0) = 0 Then
    lDC = GetDC(0)
    lDPI(0) = GetDeviceCaps(lDC, 88&)    'this is the horizontal 
                                         'resolution of the user's screen,
                                         'in DPI
    lDPI(1) = GetDeviceCaps(lDC, 90&)    'vertical
    lDC = ReleaseDC(0, lDC)
End If

Zoom = R.Parent.Parent.Windows(1).Zoom
x = (R.Left + 0.5 * R.Width) * Zoom / 100 / 72 * lDPI(0)
y = (R.Top + 0.5 * R.Height) * Zoom / 100 / 72 * lDPI(1)
SetCursorPos x, y

End Sub