Друзья, добрый день! Решаю такую задачу: для работы макроса необходимо знать, где располагаются определенные элементы на мониторе в данный момент (расположение может быть разное, но в рамках одного цикла работы макроса элементы находятся в одном положении). Для этого хотелось бы, чтобы программа спросила через Inputbox или как-то еще, например, "Щелкните на элементе <плюсик>", пользователь щелкает мышкой на плюсике (либо же наводит на плюсик и нажимает какую-то кнопку, если мышкой нельзя щелкать) и координаты мыши добавляются в переменную, с которой потом уже будем работать.
Нашел такой код:
Код
Код
' Access the GetCursorPos function in user32.dll
Declare Function GetCursorPos Lib "user32" _
(lpPoint As POINTAPI) As Long
' Access the GetCursorPos function in user32.dll
Declare Function SetCursorPos Lib "user32" _
(ByVal x As Long, ByVal y As Long) As Long
' GetCursorPos requires a variable declared as a custom data type
' that will hold two integers, one for x value and one for y value
Type POINTAPI
X_Pos As Long
Y_Pos As Long
End Type
' Main routine to dimension variables, retrieve cursor position,
' and display coordinates
Sub Get_Cursor_Pos()
' Dimension the variable that will hold the x and y cursor positions
Dim Hold As POINTAPI
' Place the cursor positions in variable Hold
GetCursorPos Hold
' Display the cursor position coordinates
MsgBox "X Position is : " & Hold.X_Pos & Chr(10) & _
"Y Position is : " & Hold.Y_Pos
End Sub
' Routine to set cursor position
Sub Set_Cursor_Pos()
' Looping routine that positions the cursor
For x = 1 To 480 Step 20
SetCursorPos x, x
For y = 1 To 40000: Next
Next x
End Sub
Он отлично работает, встаю мышью куда мне надо, нажимаю F5, получаю координаты. Как это реализовать применимо к описанной выше идее, что это должен быть диалог с пользователем? Нужно какую-то свою форму рисовать? Покажите, пожалуйста, на примере "появилось окно с просьбой указать элемент - я кликаю на элемент - координаты попали в переменную".
Спасибо.
Update: или вот еще какую красоту нашел :-) (если запустить, и таймер бегает и в режиме реального времени координаты отображаются). Как прикрутить, чтобы спрашивало у пользователя кликнуть в точку, у которой нужно получить координаты.
Код
Private Declare Function setcursorpos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal swextrainfo As Long) Private Const mouseeventf_leftdown = &H2 Private Const mouseeventf_leftup = &H4 Private Const mouseeventF_Rightdown As Long = &H8 Private Const mouseeventF_rightup As Long = &H10
Declare Sub sleep Lib "kernel32" (ByVal dwmilliseconds As Long)
Public Declare Function GetCursorPos Lib "user32" (lpPoint As PointAPI) As Long Public Type PointAPI x As Long y As Long End Type
Sub MouseMove() Dim lngCurPos As PointAPI Dim startTime As Double Dim SecondsElapsed As Double Dim MinutesElapsed As String
If SecondsElapsed < SecondsToActivate * 0.7 Then Worksheets("Sheet1").Range("B4").Font.Color = RGB(0, 0, 255) ElseIf SecondsElapsed >= SecondsToActivate * 0.7 And SecondsElapsed < SecondsToActivate * 0.8 Then Worksheets("Sheet1").Range("B4").Interior.ColorIndex = 6 Worksheets("Sheet1").Range("B4").Font.Color = RGB(0, 0, 255) ElseIf SecondsElapsed >= SecondsToActivate * 0.8 And SecondsElapsed < SecondsToActivate * 0.9 Then Worksheets("Sheet1").Range("B4").Interior.ColorIndex = 46 Worksheets("Sheet1").Range("B4").Font.Color = RGB(0, 0, 255) ElseIf SecondsElapsed >= SecondsToActivate * 0.9 And SecondsElapsed < SecondsToActivate * 0.95 Then Worksheets("Sheet1").Range("B4").Interior.ColorIndex = 3 Worksheets("Sheet1").Range("B4").Font.Color = RGB(255, 255, 255) ElseIf SecondsElapsed >= SecondsToActivate * 0.95 Then If SecondsElapsed Mod 2 <> 0 Then Worksheets("Sheet1").Range("B4").Interior.ColorIndex = 3 Worksheets("Sheet1").Range("B4").Font.Color = RGB(255, 255, 255) End If End If
If SecondsElapsed >= SecondsToActivate Then Worksheets("Sheet1").Range("B4").Interior.ColorIndex = xlNone Worksheets("Sheet1").Range("B4").Font.Color = RGB(0, 0, 255) For I = 1 To 500 For J = 1 To 100 setcursorpos x1 + J, y1 Next J For J = 99 To 0 Step -1 setcursorpos x1 + J, y1 Next J Next I
БМВ, да, забыл упомянуть... Речь идет об элементах программы 1С, т.е. стороннее приложение. Интересует их абсолютное расположение на экране в пикселях, что и делает приложенный мой первый код. Если это важно, то монитора два.
Вроде вот так работает, мою проблему решает, но некрасиво:
Код
Код
#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
'=========получим координаты плюсика============================
MsgBox "Встаньте на плюcик, нажмите ENTER"
GetCursorPos llCoord
PlusikX = llCoord.Xcoord
PlusikY = llCoord.Ycoord
'=========получим координаты стрелочки============================
MsgBox "Встаньте на стрелочку, нажмите ENTER"
GetCursorPos llCoord
StrelochkaX = llCoord.Xcoord
StrelochkaY = llCoord.Ycoord
End Sub
Буду благодарен, если кто подскажет, как сделать, чтобы пользователю предлагалось кликнуть на условный плюсик, и по клику мышью, координаты плюсика добавлялись бы в переменную.