mtheriault2000
Well-known Member
- Joined
- Oct 23, 2008
- Messages
- 826
Hello again
I want to get a routine that will place an arrow where the mouse is pointing. To do that, i use a modified code base on member "Rorya" to catch the mouse position and display an arrow.
Works, but i got an offset on the resulting position.
In red, the value that i modified to get near the desired position.
What formula should i use to get it place at the good place.
Martin
I want to get a routine that will place an arrow where the mouse is pointing. To do that, i use a modified code base on member "Rorya" to catch the mouse position and display an arrow.
Works, but i got an offset on the resulting position.
In red, the value that i modified to get near the desired position.
What formula should i use to get it place at the good place.
Martin
Rich (BB code):
Option Explicit
Public XPos As Long, YPos As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
(ByVal hwnd1 As Long, ByVal hwnd2 As Long, ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Type POINTAPI
X As Long
Y As Long
End Type
Dim Pos As POINTAPI
Const csglSHAPE_SIZE As Single = 20
Public Sub GetCoordinates()
'Action sub deployed by clicking the ActionKey.
Dim P As RANGE, PN As String
Dim shp As Shape
GetCursorPos Pos
'Record
XPos = Pos.X
YPos = Pos.Y
With ActiveWindow
XPos = 20 + (XPos - .PointsToScreenPixelsX(0)) * 58 / .Zoom
YPos = (YPos - .PointsToScreenPixelsY(0)) * 60 / .Zoom
End With
End Sub
Sub test1()
Dim mydocument As Variant
Call GetCoordinates
Set mydocument = Worksheets(1)
mydocument.Shapes.AddShape msoShapeUpArrow, XPos, YPos, 5, 20
End Sub
Last edited: