Leggere la posizione del cursore, assegnare la posizione al cursore e cliccare

Stato
Chiusa ad ulteriori risposte.

ggratis

VBA Expert
Expert
27 Settembre 2015
1.219
48
Lecce - Pisa
Excel 2010
32
discussione

Visual Basic:
Option Explicit
'https://support.microsoft.com/it-it/help/152969/visual-basic-procedure-to-get-set-cursor-position
' accesso in lettura alla funzione GetCursorPos del modulo user32.dll che contiene le funzioni di windows api (PtrSafe va omesso per 32 bit)
Declare PtrSafe Function GetCursorPos Lib "User32" (lpPoint As POINTAPI) As Long
' accesso in scrittura alla funzione GetCursorPos del modulo user32.dll
Declare PtrSafe Function SetCursorPos Lib "User32" (ByVal x As Long, ByVal y As Long) As Long
' la funzione GetCursorPos richiede una variabile dichiarata come tipo dati personalizzato
' che conterrà due numeri interi, uno per il valore x ed uno per il valore y
Public Declare PtrSafe Function GetSystemMetrics32 Lib "User32" _
    Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long
'GetSystemMetrics32 rileva le dimensioni dello schermo: larghezza=GetSystemMetrics32(0), altezza=GetSystemMetrics32(1)
Type POINTAPI
    X_Pos As Long
    Y_Pos As Long
End Type
' Routine principale per dimensionare le variabili, recuperando la posizione del cursore e visualizzandone le coordinate
' Posizionare il cursore all'interno della Routine Get_Cursor_Pos() e digitare il tasto F5 per eseguirla
Sub Get_Cursor_Pos()
    ' Dimensiona la variabile, di tipo dati personalizzato POINTAPI, che conterrà la posizione del cursore: x e y
    Dim Hold As POINTAPI
    ' lettura della posizione del cursore che viene assegnata alla variabile Hold
    GetCursorPos Hold
    ' Visualizzazione delle coordinate della posizione del cursore
    MsgBox "X Position is : " & Hold.X_Pos & Chr(10) & "Y Position is : " & Hold.Y_Pos
End Sub
' Routine per assegnare la posizione del cursore
Sub Set_Cursor_Pos()
    Dim x As Long, y As Long
    ' ciclo di posizionamento del cursore (per la visualizzazione farlo avanzare con F8)
    For x = 1 To GetSystemMetrics32(0) Step 100
        For y = 1 To GetSystemMetrics32(1) Step 20
        SetCursorPos x, y
        Next
    Next x
End Sub
 
Ultima modifica:
  • Like
Reactions: Powerwin and ges

ggratis

VBA Expert
Expert
27 Settembre 2015
1.219
48
Lecce - Pisa
Excel 2010
32
Click...
mouse_event
Visual Basic:
'Declare, Dichiara un riferimento a una routine implementata in un file esterno
'https://docs.microsoft.com/it-it/dotnet/visual-basic/language-reference/statements/declare-statement

'operazione necessaria per poterla utilizzare nel nostro modulo; nel nostro caso, andremo ad usare:
'* la Sub mouse_event della libreria "user32"
'* la Function SetCursorPos della libreria "user32"
'* la sub Sleep della libreria "kernel32"

'a seconda che il sistema sia a 64 o 32 bit la dichiarazione delle routin dovrà essere preceduta o meno dalla parola chiave PtrSafe
'https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/ptrsafe-keyword

'ed alle variabili dovranno essere assegnati i tipi di dato corretti, laddove siano stati aggiornati
'https://docs.microsoft.com/it-it/dotnet/visual-basic/language-reference/statements/declare-statement
'https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/declare-statement
'il simbolo # davanti ad if, indica che si tratta di una direttiva
'https://docs.microsoft.com/it-it/dotnet/visual-basic/language-reference/directives/
'le direttive sono eseguite in fase di compilazione del listato, e non in fase di esecuzione; in questo modo le nostre dichiarazioni
'sono compilate in modo corretto a seconda della versione del linguaggio e del sistema operativo (se a 64 o 32 bit).

#If VBA7 Then
    Declare PtrSafe Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, _
                                                  ByVal dy As Long, ByVal cButtons As Long, _
                                                   ByVal dwExtraInfo As LongPtr)
    Declare PtrSafe Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
    Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#Else
    Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, _
                                                  ByVal dy As Long, ByVal cButtons As Long, _
                                                  ByVal dwExtraInfo As Long)
    PtrSafe Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
    PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If
'di seguito sono dichiarate delle costanti, che potranno essere passate alla sub mouse_event precedentemente dichiarata.
'Alcune di queste costanti sono valide solo per determinati sistemi operativi...
'http://allapi.mentalis.org/apilist/mouse_event.shtml

Public Const MOUSEEVENTF_MOVE As Long = &H1 ' &H1 --> 1
'
Public Const MOUSEEVENTF_LEFTDOWN As Long = &H2 ' &H indica un numero esadecimale &H2 --> 2 decimale
Public Const MOUSEEVENTF_LEFTUP As Long = &H4 ' &H4 --> 4
Public Const MOUSEEVENTF_RIGHTDOWN As Long = &H8 ' &H8 --> 8
Public Const MOUSEEVENTF_RIGHTUP As Long = &H10 ' &H10 --> 16
'
Public Const MOUSEEVENTF_MIDDLEDOWN As Long = &H20 ' &H20 --> 32
Public Const MOUSEEVENTF_MIDDLEUP As Long = &H40 ' &H40 --> 64

Public Const MOUSEEVENTF_XDOWN As Long = &H80 ' &H80 --> 128
Public Const MOUSEEVENTF_XUP As Long = &H100 ' &H100 --> 256

Public Const MOUSEEVENTF_WHEEL As Long = &H800 ' &H800 --> 2048
Public Const MOUSEEVENTF_HWHEEL As Long = &H1000 ' &H1000 --> 4096
'
Public Const MOUSEEVENTF_ABSOLUTE As Long = &H8000 ' &H1000 --> 32768

'di seguito sono indicate alcune sub che illustrano la modalità di utilizzo delle sub precedentemente dichiarate
'e che riproducono determinati comportamenti del mouse

'il singolo click nel punto di coordinate 100,100 (l'origine è nell'angolo superiore sinistro del monitor, con
'asse x diretto verso destra ed asse y diretto verso il basso
Private Sub SingleClick()
  'si chiama la sub SetCursorPos per impostare la posizione del mouse nel punto di coordinate 100,100
  SetCursorPos 100, 100 'x e y della posizione del click
  'il click è composto da due eventi la pressione ed il rilascio del pulsante
  'evento di pressione del mouse
  mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
  'evento di rilascio del mouse
  mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
End Sub

'il doppio click del mouse nella posizione 100,100
Private Sub DoubleClick()
  'Doppio plick è una successione rapida di due clicks
  SetCursorPos 100, 100 'x e y della posizione del doppio click
  mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
  mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
  mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
  mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
End Sub
'il click del tasto destro del mouse nella posizione 200,200
Private Sub RightClick()
  'click destro
  SetCursorPos 200, 200 'x e y della posizione del click destro
  mouse_event MOUSEEVENTF_RIGHTDOWN, 0, 0, 0, 0
  mouse_event MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0
End Sub

Private Sub Wheel_Up()
  'ruota la rotella in avanti
  SetCursorPos 500, 500 'x e y della posizione in cui è ammesso il funzionamento
    mouse_event MOUSEEVENTF_WHEEL, 0, 0, 100, 0
End Sub
Private Sub Wheel_Down()
  'ruota la rotella indietro
  SetCursorPos 500, 500 'x e y della posizione in cui è ammesso il funzionamento
    mouse_event MOUSEEVENTF_WHEEL, 0, 0, -100, 0
End Sub

Private Sub DragAndDrop()
  'assicuratevi che sullo schermo nella posizione 100,100 si presente un file o una cartella, noterete che sarà spostato
  'nella posizione 400,400
  SetCursorPos 100, 100 'x e y della posizione iniziale (in questa posizione ci deve essere l'icona di qualcosa
  mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
  SetCursorPos 400, 400 'x e y della posizione finale
  Sleep 35 'bisogna dargli un po' di tempo altrimenti se l'esecuzione è troppo veloce non funziona
  mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
End Sub
 
Ultima modifica:
  • Like
Reactions: ges

Zer0Kelvin

VBA Expert
Expert
19 Novembre 2016
1.544
63
59
Teramo (Provincia)
zer0kelvin.altervista.org
2010
92
Ciao.
Innanzitutto grazie per la condivisione.
Solo un appunto: dal momento che l'utilizzo di Office a 64 bit si sta diffondendo alquanto, sarebbe opportuno che eventuali istruzioni Declare ne tengano conto.

PS: hai scritto DrugAndDrop (a che pensavi eh? Fumato_) invece di DragAndDrop.
Saluto_saluto
 

ggratis

VBA Expert
Expert
27 Settembre 2015
1.219
48
Lecce - Pisa
Excel 2010
32
(a che pensavi eh? Fumato_)
...mariiiaaa! ';)

dal momento che l'utilizzo di Office a 64 bit si sta diffondendo alquanto, sarebbe opportuno che eventuali istruzioni Declare ne tengano conto
Non ho capito bene a cosa ti riferisci, ma presumo siano utili i seguenti link
https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/declare-statement
https://docs.microsoft.com/it-it/office/vba/Language/Concepts/Getting-Started/64-bit-visual-basic-for-applications-overview
https://jkp-ads.com/Articles/apideclarations.asp
 
Ultima modifica:

giulianovac

Access/VBA Expert
Expert
9 Giugno 2018
1.751
83
Italy
2013 2019
130
Credo che, oltre al codice, sarebbe utile anche qualche spiegazione che aiuti l'utente a capire lo scopo ed il significato dello stesso.
 
  • Like
Reactions: rollis13

ggratis

VBA Expert
Expert
27 Settembre 2015
1.219
48
Lecce - Pisa
Excel 2010
32
Un saluto a tutti e grazie intanto per la partecipazione,
ho aperto due discussioni proprio per questo, perché con i vostri commenti mi piacerebbe arricchire strada facendo l'argomento, ma vedo che ci stiamo accodando tutti sotto questa discussione (che avevo lasciato chiusa), senza considerare quest'altra che aveva proprio questo scopo (e che è aperta agli interventi di tutti)...
Ringraziando Zer0Kelvin @Zer0Kelvin che mi ha dato l'occasione di integrare e correggere il listato e, tempo permettendo (Poco!), proverò ad aggiungere qualche altro commento come suggerito da giulianovac @giulianovac ...
Se fosse possibile sposterei i commenti sull'altra discussione mantenendo in questa il codice commentato come riterrete più opportuno, per quello non sono geloso ';) . Se condividete mi piacerebbe seguire questa strada...
Saluto_salutocappello_saluta
 
Ultima modifica:
Stato
Chiusa ad ulteriori risposte.

Sostieni ForumExcel

Aiutaci a sostenere le spese e a mantenere online la community attraverso una libera donazione!