How to automatically drop textbox/shape at mouse cursor position?

[M. Brown]

I am trying to write a VBA macro that will drop a text box at the mouse
cursor location via keyboard shortcut. The macro is intended for PowerPoint
2003 but the problem could be applied to any of the Office programs. I have
been partially successful in developing a solution so far. However, the
problem is that I cannot seem to find a method for determining the location
of the PowerPoint slide relative to the screen. All I need is either the
pixel or point coordinates of the slide (either center or corner would work)
relative to my computer screen origin.

My partical solution uses GetCursorPos Lib "user32" to get the mouse cursor
position in pixels. Then I use the PixelsToPoints function in the Word 11.0
Object Library so that I can convert the mouse cursor position to points. I
have to scale the
resulting value to account for the zoom size of the slide and apply an
offset (currently a constant determined by trial and error but needs to be
dynamic) to account for the slide position relative to the screen origin.
Here is my code. My arbitrary offset constant works as long as I am using a
monitor with 1280 by 800 resolution and have the slide centered and zoomed at
65%.

Does anyone have any ideas?

------------------------
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(msoTextOrientationHorizontal, MouseCursorPosX, MouseCursorPosY, 40, 23).Select
ActiveWindow.Selection.TextRange.Text = "X"
End Sub

[Jasper Butler]

BUMP

I am trying to do the exact same thing. Have you ever figured this out?

> Submitted via EggHeadCafe - Software Developer Portal of Choice
> Lucene.Net Indexing Searching Entry Level Tutorial
> http://www.eggheadcafe.com/tutorials/aspnet/c69ef65f-e3c6-409e-ab97-168897c74f83/lucenenet-indexing-searching-entry-level-tutorial.aspx