Position en X et Y de la souris

[gsx-air]

salut a tous
c'est mon premier message

voila je cherche a obtenir la position de ma souris dans deux cellules

une cellule pour le X et une pour les Y et eventuellement un bouton pour faire une RAZ

la position de la souris n'a aucun rapport avec sa position dans la fenetre excel
le but final est de faire un cercle (ou autre forme) avec la souris et pouvoir recuperer la position de tous les points qui constituent la forme

je precise que je debute en VBA

(existe t'il des ouvrages sur le VBA pou debutant )

merci

 

[job75]

Re : Position en X et Y de la souris

Bonjour xhudi69, Misange,

Mais voilà, l'UserForm suit la souris de façon logarythmique au lieu de coller à elle, je n'ai pas trouvé la solution et tourne un peu en rond.

Ce n'est pas logarithmique mais homothétique, apparemment l'API GetCursorPos ne donne pas les mêmes résultats sur une TextBox et sur une feuille de calcul.

Avec ceci ce n'est pas trop mal :

coef = 0.6
UserForm2.Left = coef * pos.x + 20
UserForm2.Top = coef * pos.y

A+

 

[job75]

Re : Position en X et Y de la souris

Re,

apparemment l'API GetCursorPos ne donne pas les mêmes résultats sur une TextBox et sur une feuille de calcul.

C'est faux, sur mon ordi l'API renvoie dans les 2 cas X = 1600 pour le bord droit de l'écran.

C'est en fait l'UserForm qui ne mesure pas avec la même unité.

A+

 

[xhudi69]

Re : Position en X et Y de la souris

Bonsoir job75 ,le Forum,

Bonne année 2014 et meilleurs voeux de santé,

Merci pour ta réponse, en tatonnant, le bon coeff pour moi est comme suit:

coef = 0.77
GetCursorPos pos

UserForm2.Left = coef * pos.X
UserForm2.Top = coef * pos.Y

C'est faux, sur mon ordi l'API renvoie dans les 2 cas X = 1600 pour le bord droit de l'écran.

Je l'avais constaté, merci encore pour l'amélioration du code.

Une dernière question, je n'ai pas trouvé sur le net un ControlTip Text MultiLine, est-ce vraimment le cas?

@+

 

[Roland_M]

Re : Position en X et Y de la souris

bonjour à tous,

il ne s'agit pas de 0,77 mais 0,75 !
le résultat obtenu avec 0,77 doit être dû à des arrondis !
ne pas confondre point(objet) et pixel(résolution) 1pixel=0.75point
ex avec une résolution d'écran en cours de 1600x900
et avec un Userform.Width=1200 et Userform.Height=675
l'Userform prendra tout l'écran !

 

[Roland_M]

Re : Position en X et Y de la souris

re:

pour vérifier mes dires,
voir ces routines à placer dans un module.

'API Function FResolutionX/Y() GetSystemMetrics(0/1)=X/Y  ou les 3 suivantes
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
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

'Val BitParPixel (4=16 Color) (8=256 Color) (16=High Color) (24,32=True Color)
'Val FreqRefresh (0, 1=Hardware default) (sinon=User-selected)
'1 pixel = 0.75 points 72 points par pouce (sur 25,4 mm)

'hDC& = GetDC(0)
'ScreenX& = GetDeviceCaps(hDC&, 8) '        8 = horizontal
'ScreenY& = GetDeviceCaps(hDC&, 10) '      10 = vertical
'BitPixel& = GetDeviceCaps(hDC&, 12) '     12 = Bit par Pixel
'PointPixel& = GetDeviceCaps(hDC&, 88) '   88 = Point par Pixel
'FreqRefresh& = GetDeviceCaps(hDC&, 116) '116 = Freq de REFRESH
'ReleaseDC 0, hDC
'PointsPixel! = 72 / PointPixel&

'---------------------------------------------------------------------------
Sub ESSAI_TEMP() 'essai avec F5
M$ = "point par pixel = " & FPointsParPixel & vbLf & _
     "résolution en cours:  " & FResolutionX & "x" & FResolutionY & vbLf & _
     "dim écran en points: " & FScreenWidth & "x" & FScreenHeight
MsgBox M$
End Sub
'---------------------------------------------------------------------------


Public Function FPointsParPixel() As Single
hDC& = GetDC(0): FPointsParPixel = 72 / GetDeviceCaps(hDC&, 88): ReleaseDC 0, hDC&
End Function

Public Function FResolutionX() 'X pixel
'FResolutionX = GetSystemMetrics(0) '< ceci avec la Function GetSystemMetrics
hDC& = GetDC(0): FResolutionX = GetDeviceCaps(hDC&, 8): ReleaseDC 0, hDC&
End Function
Public Function FResolutionY() 'Y pixel
'FResolutionY = GetSystemMetrics(1) '< ceci avec la Function GetSystemMetrics
hDC& = GetDC(0): FResolutionY = GetDeviceCaps(hDC&, 10): ReleaseDC 0, hDC&
End Function

Public Function FScreenWidth() 'W point
FScreenWidth = FResolutionX * FPointsParPixel
End Function
Public Function FScreenHeight() 'H point
FScreenHeight = FResolutionY * FPointsParPixel
End Function

 

[xhudi69]

Re : Position en X et Y de la souris

Bonsoir Roland_M, le Forum,

Excellente année 2014 pour toi,

Rigoureusement exact, le bon coéficient est de 0,75, merci beaucoup pour ce code avec lequel j'ai pu le vérifier.

Bonne soirée

 

[Michel_ja]

Re : Position en X et Y de la souris

Bonsoir à toutes et à tous et bonne année 2014


Je reprends ce fil pour répondre à mon soucis de remplacer avantageusement un ControlTip Text (que je ne peux pas mettre en Multiline).
Grace au fichier de job75 (merci à lui ), je peux faire afficher un UserForm qui colle à la souris dans l'évennement MouseMove d'un TextBox.
Mais voilà, l'UserForm suit la souris de façon logarythmique au lieu de coller à elle, je n'ai pas trouvé la solution et tourne un peu en rond.

Merci à vous pour votre travail

@+

Bonjour à tous.
le sujet m'intéresse beaucoup aujourd'hui, celui d'identifier la position du curseur sur l'écran.
Malheureusement je n'arrive pas à faire fonctionner votre position de macro à cause de la version 64 bit. Ci-joint les photos des messages.
Vous saver comment adapter le code ?
Merci

 

[job75]

Bonjour Michel_ja,

l'API Windows pour Excel 64 bits :

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

A+

 

[patricktoulon]

ami du soir Bonsoir
petite astuce sans l'api timer et non bloquant et surtout sans do/loop on peux faire ce que l'on veut sur la feuille
Kado