Create textbox at cursor position

[Shrout1]

I would like to be able to place a textbox in a powerpoint presentation directly below the cursor. This will be triggered by pressing enter while a command button is selected.

Here is the code I am utilizing to get the X & Y position of my cursor:

Private Type POINTAPI
x As Long
y As Long
End Type
Private Declare Function GetCursorPos Lib "user32" _
(lpPoint As POINTAPI) As Long
Dim pos As POINTAPI ' Declare variable

Private Sub cmdGetLoc_Click()
GetCursorPos pos ' Get Co-ordinates
MsgBox "Cursor Pointer is at:" & vbNewLine _
& "x:=" & pos.x & vbNewLine _
& "y:=" & pos.y
End Sub


The following thread from 2008 seems to touch on what I am trying to do, but doesn't fully explore the solution.

http://tek-tips.com/viewthread.cfm?qid=1459089&page=2

I need some way to either:
1)Translate the X,Y coordinates from my monitor (with its 1440x900 resolution) into left/top coordinates or

2)Detect that the cursor is on the presentation and drop a textbox directly onto my X,Y coords without using left/top at all.

The first solution isn't ideal either as someone else using a different resolution screen will not always have the same positioning of windows, etc. Furthermore, I may not have Powerpoint maximized etc.

Any thoughts would be greatly appreciated!

[Shrout1]

Take a look at this thread here:

http://groups.google.com/group/microsoft.public.word.vba.customization/browse_thread/thread/13b0f473e4d08ac9/e4cfff0ad3987353?lnk=raot

Appears that this individual is trying to do the exact same thing as myself. I can't even seem to get the PointsToPixels method to work:

Originally posted by M. Brown on the linked thread:
Private Type POINTAPI
X As Long
Y As Long
End Type


Private Declare Function GetCursorPos Lib "user32" _
(lpPoint As POINTAPI) As Long

Public Function GetXCursorPos() As Long
Dim pt As POINTAPI
GetCursorPos pt
GetXCursorPos = pt.X
End Function

Public Function GetYCursorPos() As Long
Dim pt As POINTAPI
GetCursorPos pt
GetYCursorPos = pt.Y
End Function

Public Sub DropXMacro()
Dim MouseCursorPosX As Long
Dim MouseCursorPosY As Long

If ((PixelsToPoints(GetXCursorPos(), False) / (ActiveWindow.View.Zoom /
100)) - 355) < 0 Then
MouseCursorPosX = 0
ElseIf ((PixelsToPoints(GetXCursorPos(), False) /
(ActiveWindow.View.Zoom / 100)) - 355) > 720 Then
MouseCursorPosX = 720
Else
MouseCursorPosX = (PixelsToPoints(GetXCursorPos(), False) /
(ActiveWindow.View.Zoom / 100)) - 355
End If

If ((PixelsToPoints(GetYCursorPos(), True) / (ActiveWindow.View.Zoom /
100)) - 226) < 0 Then
MouseCursorPosY = 0
ElseIf ((PixelsToPoints(GetYCursorPos(), True) / (ActiveWindow.View.Zoom
/ 100)) - 226) > 540 Then
MouseCursorPosY = 540
Else
MouseCursorPosY = (PixelsToPoints(GetYCursorPos(), True) /
(ActiveWindow.View.Zoom / 100)) - 226
End If
ActiveWindow.Selection.SlideRange.Shapes.AddTextbox(msoTextOrientationHoriz ­ontal, MouseCursorPosX, MouseCursorPosY, 40, 23).Select
ActiveWindow.Selection.TextRange.Text = "X"
End Sub

[John Wilson]

Just checking. You are adding the textbox in show mode??

If so - Why?

If in edit mode did you get the command button to fire when you hit enter?

[Shrout1]

I am trying to add textboxes in Edit mode. I am not overly familiar with the sample code I posted - is there a piece within it that indicates "Show" mode?"

I can't get the sample code to execute as PointsToPixels doesn't appear to work.

Like I mentioned, that code is from the thread that I hyperlinked.

[John Wilson]

No, but the command button won't fire the code in edit mode will it??

[Shrout1]

No, but the command button won't fire the code in edit mode will it??

You may be correct but I have not been attempting to to trigger the code sample with a command button, I've just been stepping directly into it from the module.

What is the complication involved with the command button?