After pasting to a code module, run the TestMoveCursor routine. It will move
the cursor to the center of the first shape object on the worksheet. Change
this code to suit.
The appended PointsPerPixelX and PointsPerPixelY functions and their API
code plus the two declared constants is from my code library and is
attributed to an old Stephen Bullen post that is no longer accessible.
Private Declare Function SetCursorPos Lib "user32.dll" _
(ByVal x As Long, ByVal y As Long) As Long
Private Declare Function GetDC Lib "user32" _
(ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" _
(ByVal hwnd As Long, ByVal hDC As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" _
(ByVal hDC As Long, ByVal nIndex As Long) As Long
Const LOGPIXELSX = 88
Const LOGPIXELSY = 90
Function PointsPerPixelX() As Double
Dim hDC As Long
hDC = GetDC(0)
PointsPerPixelX = 72 / GetDeviceCaps(hDC, LOGPIXELSX)
ReleaseDC 0, hDC
End Function
Function PointsPerPixelY() As Double
Dim hDC As Long
hDC = GetDC(0)
PointsPerPixelY = 72 / GetDeviceCaps(hDC, LOGPIXELSY)
ReleaseDC 0, hDC
End Function
Private Sub MoveCursor(Lft As Single, Tp As Single)
Dim wsleft As Single, wstop As Single
Dim L As Single, T As Single
Dim Z As Double
With ActiveWindow
Z = .Zoom / 100
wsleft = .PointsToScreenPixelsX(0)
wstop = .PointsToScreenPixelsY(0)
L = wsleft + Z * (Lft / PointsPerPixelX)
T = wstop + Z * (Tp / PointsPerPixelY)
End With
SetCursorPos L, T
End Sub
Sub TestMoveCursor()
Dim s As Shape
Set s = ActiveSheet.Shapes(1)
MoveCursor s.Left + s.Width / 2, s.Top + s.Height / 2
End Sub
Regards,
Greg
