Userform.show on cursor position - excel

Question

i wish to create code that will open form at any form object by mouse hover. For now i have form.show and unload form on mousemove event.
I can add some variable to each object to recognize their position on window and define top left like on example
Private Sub UserForm_Initialize()
If par_hoverForm = uf_Generator.com_MaxQty.Name Then
Me.Top = Application.Top + uf_Generator.Top + uf_Generator.fr_settings.Top + uf_Generator.com_MaxQty.Top + uf_Generator.com_MaxQty.Height + 30
Me.Left = uf_Generator.Left + uf_Generator.fr_settings.Left + uf_Generator.com_MaxQty.Left + 10
End If
End Sub
but is it possible to form.show at cursor position + some offset? this code getting cursor coordinates but i dont know how to convert it to top/left.
#If VBA7 Then
Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
#Else
Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
#End If
' Create custom variable that holds two integers
Type POINTAPI
Xcoord As Long
Ycoord As Long
End Type
Sub GetCursorPosDemo()
Dim llCoord As POINTAPI
' Get the cursor positions
GetCursorPos llCoord
' Display the cursor position coordinates
MsgBox "X Position: " & llCoord.Xcoord & vbNewLine & "Y Position: " & llCoord.Ycoord
End Sub
any advice are welcome

Answer 1

I will show you one way to do it, which should allow you to customize it to your needs.
First, this is the base code to convert the pixels to point and move an object to the pointer. I've set it to be called with another object, but obviously you can code a specific object in there:
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Public Sub position(this As Object)
Dim lngCurPos As POINTAPI
Dim DocZero As POINTAPI
Dim PointsPerPixelY As Double
Dim PointsPerPixelX As Double
Dim hdc As Long
hdc = GetDC(0)
PointsPerPixelY = 72 / GetDeviceCaps(hdc, 90)
PointsPerPixelX = 72 / GetDeviceCaps(hdc, 88)
ReleaseDC 0, hdc
DocZero.Y = ActiveWindow.PointsToScreenPixelsY(0)
DocZero.X = ActiveWindow.PointsToScreenPixelsX(0)
GetCursorPos lngCurPos
this.Top = (lngCurPos.Y - DocZero.Y) * PointsPerPixelY
this.Left = (lngCurPos.X - DocZero.X) * PointsPerPixelX
End Sub
This worked well for my little test object, but not quite for my form.
For my form, I changed the last two rows to: (Your Mileage May Vary)
this.Top = (lngCurPos.Y - DocZero.Y) * PointsPerPixelY + this.Height * 2.2
this.Left = (lngCurPos.X - DocZero.X) * PointsPerPixelX - this.Width / 2.5
Then, in my Form1 TextBox, I use Call position(UserForm2) in the MouseMove event to update the position of UserForm2 constantly.
One problem I had, was that I was also calling UserForm2.show, which kept resetting the position, making it jump around.
To get around this, I added another function:
Public Function IsLoaded(formName As String) As Boolean
Dim frm As Object
For Each frm In VBA.UserForms
If frm.Name = formName Then
IsLoaded = True
Exit Function
End If
Next frm
IsLoaded = False
End Function
And then my UserForm1 Code looks like this:
Private Sub TextBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Not IsLoaded("UserForm2") Then UserForm2.show
Call position(UserForm2)
End Sub
I did not add any code to remove Form2 again, since you have that already.
This was my result: