- Gibt es eine Möglichkeit, innerhalb eines Makros den
Benutzer ein Objekt mit der Maus auswählen zu lassen?
Hallo Christoph,
man könnte bei einem Linksklick die aktuelle Mausposition auswerten und prüfen über welchem Objekt die Maus gerade geklickt haben muß.
Nachstehender gefundener Code zeigt das Prinzip.
Tipp, beende alle anderen Excelmappen und übe in einer leeren neuen Mappe, irgendwie läßt sich der Code nicht stoppen.
Dann hol dir aus Ansicht—Smbolleiste die Symbolleiste Formular , daraus eine Schaltfläche und weise ihr das makro prcStartTimer zu.
Dann klicke auf die Schaltfläche, anschließend beliebig woanders hin, dir wird dann die Mausposition angezeigt.
Gruß
Reinhard
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( \_
ByVal lpClassName As String, \_
ByVal lpWindowName As String) As Long
Private Declare Function SetTimer Lib "user32.dll" ( \_
ByVal hWnd As Long, \_
ByVal nIDEvent As Long, \_
ByVal uElapse As Long, \_
ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32.dll" ( \_
ByVal hWnd As Long, \_
ByVal nIDEvent As Long) As Long
Private Declare Function GetCursorPos Lib "user32.dll" ( \_
ByRef cPoint As POINTAPI) As Long
Private Declare Function GetAsyncKeyState Lib "user32.dll" ( \_
ByVal vKey As Long) As Integer
Private Type POINTAPI
x As Long
y As Long
End Type
Private Const GC\_CLASSNAMEMSWORD = "OpusApp"
Private Const VK\_LBUTTON = &H1
Private udtPoint As POINTAPI
Private intClicks As Integer
Private intCoordinates(1 To 2, 1 To 2) As Integer
Public Sub prcStartTimer()
Dim hWnd As Long
intClicks = 0
hWnd = FindWindow(GC\_CLASSNAMEMSWORD, vbNullString)
SetTimer hWnd, 0, 10, AddressOf prcTimer
End Sub
Public Sub prcStopTimer()
Dim hWnd As Long
hWnd = FindWindow(GC\_CLASSNAMEMSWORD, vbNullString)
KillTimer hWnd, 0
End Sub
Private Sub prcTimer(ByVal hWnd As Long, ByVal nIDEvent As Long, \_
ByVal uElapse As Long, ByVal lpTimerFunc As Long)
On Error Resume Next
If GetAsyncKeyState(VK\_LBUTTON) = -32767 Then
GetCursorPos udtPoint
intClicks = intClicks + 1
intCoordinates(intClicks, 1) = udtPoint.x
intCoordinates(intClicks, 2) = udtPoint.y
If intClicks = 1 Then
'prcStopTimer
MsgBox "Oben links x " & CStr(intCoordinates(1, 1)) & \_
" y " & CStr(intCoordinates(1, 2)) & \_
vbLf & " Unten rechts x " & CStr(intCoordinates(2, 1)) \_
& " y " & CStr(intCoordinates(2, 2))
End If
End If
End Sub