Position en X et Y de la souris

gsx-air

XLDnaute Nouveau
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 :rolleyes:
 

job75

XLDnaute Barbatruc
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 :

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

xhudi69

XLDnaute Accro
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:
Code:
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?

@+:cool:
 

Roland_M

XLDnaute Barbatruc
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

XLDnaute Barbatruc
Re : Position en X et Y de la souris

re:

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

Code:
'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
 
Dernière édition:

Michel_ja

XLDnaute Occasionnel
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 :eek:

@+ :cool:
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
 

Pièces jointes

  • Picture 1.jpg
    Picture 1.jpg
    87.4 KB · Affichages: 18
  • Picture 2.jpg
    Picture 2.jpg
    13.7 KB · Affichages: 18

patricktoulon

XLDnaute Barbatruc
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
demo2.gif
 

Pièces jointes

  • get position and mesure and object.xlsm
    29.8 KB · Affichages: 27

Discussions similaires

Statistiques des forums

Discussions
311 711
Messages
2 081 792
Membres
101 817
dernier inscrit
carvajal