Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Greg Wilson - XY coordinates of a worksheet
Greg Wilson ....
You mentioned a function to determine the X-Y coordinates of a worksheet in the following post. The link does not work any longer - do you still have the example available? _______________________________ "The code below will return the x- and y-coordinates in pixels as opposed to points. Note that it is also window based instead of worksheet based. Doing something with it is the challenge: Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long Type POINTAPI x As Long y As Long End Type Sub xxx() Dim pos As POINTAPI GetCursorPos pos MsgBox pos.x & vbCr & pos.y End Sub I have recently posted code that determines the position of the top- left corner of the worksheet in pixels and also converts pixels to points and compensates (albeit not perfectly) for zoom. You need to know the position of the top-left corner of the worksheet in pixels so that you can subtract the correct offsets if you are to convert to points. You can thus direct the cursor to a specified point within the worksheet. If you're interested: http://tinyurl.com/l7uog " |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Greg Wilson - XY coordinates of a worksheet
Explanation of the appended demo macros:
1. The SetUp macro remaps the "z" key so that when you type "z" it will instead run the TestMoveShapeToMouse macro. It also sets the cursor to the northwest arrow. Since the demo code shows how a shape can be moved to the position of the mouse pointer, if you had to click a button to activate the macro, the shape would always go to the button since that's where the mouse pointer must go (to click it). 2. The UndoSetUp macro resets the "z" key to normal. Will also reset on closing the workbook. It also resets the cursor to Excel's default. 3. The TestMoveShapeToMouse macro is where you decide the identity of the shape you want to move to the position of the mouse pointer. Change ActiveSheet.Shapes(1) to whatever you prefer. 4. The main routine is the MoveShapeToMouse macro. It is passed the identity of the shape you want to move. It then will make it jump to the mouse pointer. Note that the zoom correction function needs work. I think I should have used simple pixel offsets instead of correction factors. Perhaps another day. You may wish to improve this yourself. Paste the following code to a standard module and run the Setup macro. Put a shape object on the worksheet. Then press the "z" key. Also try holding down the "z" key and moving the mouse. You can see how this could be used as a new way to drag shapes. You could use RangeFromPoint to identify a shape and then drag it this way for instance :- Option Explicit Private Declare Function GetDC _ Lib "user32" (ByVal hWnd As Long) As Long Private Declare Function GetDeviceCaps _ Lib "Gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long Private Declare Function ReleaseDC _ Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long Declare Function GetCursorPos _ Lib "user32.dll" (ByRef lpPoint As POINTAPI) As Long Declare Function GetKeyState _ Lib "user32" (ByVal nVirtKey As Long) As Integer Declare Function timeGetTime Lib "winmm.dll" () As Long Const LOGPIXELSX As Long = 88 Const LOGPIXELSY As Long = 90 Public Type POINTAPI x As Long y As Long End Type Sub SetUp() With Application .OnKey "z", "TestMoveShapeToMouse" .Cursor = xlNorthwestArrow End With End Sub Sub UndoSetUp() With Application .OnKey "z" .Cursor = xlDefault End With End Sub Sub TestMoveShapeToMouse() 'Change shape to suit MoveShapeToMouse ActiveSheet.Shapes(1) End Sub Sub MoveShapeToMouse(shp As Shape) Dim cp As POINTAPI Dim xpos_0 As Double, ypos_0 As Double Dim z As Double On Error Resume Next GetCursorPos cp With ActiveWindow z = CorrectZoomFactor(.Zoom) xpos_0 = .PointsToScreenPixelsX(0) ypos_0 = .PointsToScreenPixelsY(0) End With Application.Cursor = xlNorthwestArrow shp.Left = (cp.x - xpos_0) / z * PPPixelX shp.Top = (cp.y - ypos_0) / z * PPPixelY 'Application.Cursor = xlDefault On Error GoTo 0 End Sub Function PPPixelX() As Double Dim hDC As Long hDC = GetDC(0) PPPixelX = 72 / GetDeviceCaps(hDC, LOGPIXELSX) ReleaseDC 0, hDC End Function Function PPPixelY() As Double Dim hDC As Long hDC = GetDC(0) PPPixelY = 72 / GetDeviceCaps(hDC, LOGPIXELSY) ReleaseDC 0, hDC End Function 'Following zoom correction function needs work... Function CorrectZoomFactor(ByVal z As Single) As Single Select Case z Case 200 z = 2 Case 175 z = 1.765 Case 150 z = 1.529 Case 125 z = 1.235 Case 100 z = 1 Case 90 z = 0.882 Case 85 z = 0.825 Case 80 z = 0.82 Case 75 z = 0.74 Case 70 z = 0.705 Case 65 z = 0.645 Case 60 z = 0.588 Case 55 z = 0.53 Case 50 z = 0.5296 Case Else z = 1.0069 * z + 0.0055 End Select CorrectZoomFactor = z End Function |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Greg Wilson - XY coordinates of a worksheet
Sorry, the CorrectZoomFactor function was half-baked and you need to make
another minor change. In the MoveShapeToMouse macro, change: z = CorrectZoomFactor(.Zoom) to: z = CorrectZoomFactor(.Zoom / 100) Also, substitute the following for the CorrectZoomFactor function: Function CorrectZoomFactor(ByVal z As Single) As Single Select Case z Case 2 z = 2 Case 1.75 z = 1.765 Case 1.5 z = 1.529 Case 1.25 z = 1.235 Case 1 z = 1 Case 0.9 z = 0.882 Case 0.85 z = 0.825 Case 0.8 z = 0.82 Case 0.75 z = 0.74 Case 0.7 z = 0.705 Case 0.65 z = 0.645 Case 0.6 z = 0.588 Case 0.55 z = 0.53 Case 0.5 z = 0.5296 Case Else z = 1.0069 * z + 0.0055 End Select CorrectZoomFactor = z End Function Greg |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Greg Wilson - XY coordinates of a worksheet
Thanks this is very helpful - glad you were able to dig it up from
your archive. On Aug 8, 11:28 pm, Greg Wilson wrote: Sorry, the CorrectZoomFactor function was half-baked and you need to make another minor change. In the MoveShapeToMouse macro, change: z = CorrectZoomFactor(.Zoom) to: z = CorrectZoomFactor(.Zoom / 100) Also, substitute the following for the CorrectZoomFactor function: Function CorrectZoomFactor(ByVal z As Single) As Single Select Case z Case 2 z = 2 Case 1.75 z = 1.765 Case 1.5 z = 1.529 Case 1.25 z = 1.235 Case 1 z = 1 Case 0.9 z = 0.882 Case 0.85 z = 0.825 Case 0.8 z = 0.82 Case 0.75 z = 0.74 Case 0.7 z = 0.705 Case 0.65 z = 0.645 Case 0.6 z = 0.588 Case 0.55 z = 0.53 Case 0.5 z = 0.5296 Case Else z = 1.0069 * z + 0.0055 End Select CorrectZoomFactor = z End Function Greg |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
GREG I need your expertise again | Excel Discussion (Misc queries) | |||
Using Air Coordinates in a Worksheet | Excel Worksheet Functions | |||
Simple way to convert UTM ED50 coordinates to decimal coordinates? | Excel Programming | |||
Converting MouseDown Coordinates to Chart Point Coordinates | Excel Programming | |||
A MAJOR LEAGUE THANKS TO JOHN WILSON | Excel Programming |