Клик мышкой vba excel - Word и Excel - помощь в работе с программами

Имитация движения и кликов левой и правой кнопками мыши из кода VBA Excel. Эмуляция перемещения курсора и определение его текущих координат.

В VBA Excel нет методов и функций для имитации движения мыши и эмуляции кликов ее левой и правой кнопками. Но для этих целей, а также для определения текущих координат курсора, можно использовать встроенные функции Windows API — GetCursorPos, SetCursorPos и mouse_event.

Если эти функции Windows API объявить без ключевого слова Private, они будут доступны во всех модулях текущего проекта VBA.

Определение координат курсора

Определение текущих координат курсора из кода VBA Excel:

Option Explicit

Declare PtrSafe Function GetCursorPos Lib «user32» (lpPoint As POINTAPI) As Long

Type POINTAPI

X As Long

Y As Long

End Type

Sub Get_Cursor()

Dim myPoint As POINTAPI

GetCursorPos myPoint

Debug.Print «Координата X: « & myPoint.X & vbNewLine & _

«Координата Y: « & myPoint.Y & vbNewLine

End Sub

Скопируйте представленный выше код в стандартный модуль и кликните мышью внутри процедуры Get_Cursor(). Затем, перемещайте курсор мыши по экрану, не нажимая кнопок, чтобы мигающая вертикальная линия (точка вставки) не ушла из процедуры, и нажимайте клавишу F5. В окне Immediate будут печататься текущие координаты курсора. Клавишу F5 можно нажимать одновременно с процессом перемещения мыши. Значения координат X и Y отображаются в пикселях.

Имитация движения мыши

Имитация движения мыши, а, точнее, перескока мыши из одной точки в другую, осуществляется из кода VBA Excel путем задания новых координат курсору:

Option Explicit

Declare PtrSafe Function SetCursorPos Lib «user32» (ByVal X As Long, ByVal Y As Long) As Long

Sub Set_Cursor()

Dim myX As Long, myY As Long

myX = 600

myY = 400

‘Задаем курсору новые координаты

SetCursorPos myX, myY

End Sub

Переменные добавлены в пример для наглядности, их можно не использовать:

А так можно задать множественные перескоки курсора мыши:

Sub Many_Set_Cursor()

Dim i As Long

For i = 1 To 600 Step 20

Application.Wait Now + TimeValue(«0:00:01»)

SetCursorPos i, i

End Sub

Здесь перескок мыши происходит один раз в секунду.

Уменьшив задержку выполнения цикла предыдущего примера с помощью другого цикла, можно ускорить перемещение курсора и сделать его более плавным:

Sub Many_Set_Cursor_2()

Dim i As Long, i2 As Long, a As Long

For i = 1 To 600

For i2 = 1 To 100000

a = i2 / 2

SetCursorPos i, i

End Sub

Здесь уже более похоже на имитацию движения мыши.

Имитация кликов мыши

Чтобы воспроизвести имитацию кликов левой и правой кнопками мыши, нам понадобятся коды событий кнопок мыши:

Событие	Код
Нажать левую кнопку	&H2
Отпустить левую кнопку	&H4
Нажать правую кнопку	&H8
Отпустить правую кнопку	&H10

Следующий пример показывает, как установить курсор мыши в заданное место экрана и сымитировать клик правой кнопкой мыши:

Option Explicit

Declare PtrSafe Function SetCursorPos Lib «user32» (ByVal X As Long, ByVal Y As Long) As Long

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 Long)

Sub Set_Cursor_and_RightClick()

‘Устанавливаем курсор в нужную точку экрана

SetCursorPos 800, 600

‘Нажимаем правую кнопку мыши

mouse_event &H8, 0, 0, 0, 0

‘Отпускаем правую кнопку мыши

mouse_event &H10, 0, 0, 0, 0

End Sub

Я выбрал для примера имитацию клика правой кнопкой мыши из-за большей наглядности (за счет отображения контекстного меню).

Обратите внимание, что функции Windows API, используемые в примерах, должны быть объявлены только один раз.

Фразы для контекстного поиска: положение курсора, имитация клика, эмуляция клика, эмуляция движения, имитация мыши, эмуляция мыши, координаты мыши, расположение мыши, расположение курсора.

Источник

Сообщение было отмечено как решение

Решение

Ура! Наконец-то разобрался как это сделать приемлимым способом =)

Подробно опишу весь процесс для таких же чайников как я сам, ибо на рускоязычных форумах фиг найдешь нормальное описание

Visual Basic

'Подключение функции API Windows "mouse_event" из Виндосовской библиотеки "user32", которая позваляет управлять мышью
Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal dwData As Long, ByVal dwExtraInfo As Long)
'Значения параметра dwFlags, определяющие поведение функции mouse_event
Private Const MOUSEEVENTF_LEFTDOWN = &H2  'Нажать левую кнопку
Private Const MOUSEEVENTF_LEFTUP = &H4  'Отпустить левую кнопку
 
'Подключение функции API Windows "SetCursorPos", которая устанавливает позицию курсора мыши по координатам, соответствующим разрешению вашего монитора
Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
 
'Подключение функции API Windows "Sleep", её можно использовать вместо таймера, выставляя задержки в милисекундах
Private Declare Sub Sleep Lib "kernel32" (ByVal milliseconds As Long)
 
Sub MouseDragging(x1, y1, x2, y2) 'Перетаскивание объекта из координаты (x1,y1) в координаты (x2,y2)или выделение текста/изображения в прямоугольной области (x1, y1; x2, y2)
Call SetCursorPos(x1, y1)
mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
Call SetCursorPos(x2, y2)
mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
End Sub
 
Sub MouseClick(x, y) 'Клик мыши по координатам (x,y)
Call SetCursorPos(x, y)
mouse_event MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
End Sub
 
Private Sub CommandButton1_Click()
Sleep (500)
Call MouseDragging(889, 490, 388, 467)
Sleep (2000)
Call MouseClick(768, 419)
End Sub

Управление мышью осуществляется с помощью стандартной функции API Windows под названием «mouse_event», чтобы она заработала, надо вставить строку «Private Declare Sub mouse_event…» в точности, как показано сверху в коде VB. Для того чтобы указать этой функции, что конкретно надо сделать, нужно установить параметр dwFlags, который может принимать следующие значения:

Visual Basic

'Возможные значения параметра dwFlags, определяющие поведение функции mouse_event
Private Const MOUSEEVENTF_ABSOLUTE = &H8000  'Абсолютное перемещение
Private Const MOUSEEVENTF_LEFTDOWN = &H2  'Нажать левую кнопку
Private Const MOUSEEVENTF_LEFTUP = &H4  'Отпустить левую кнопку
Private Const MOUSEEVENTF_MIDDLEDOWN = &H20  'Нажать среднюю кнопку
Private Const MOUSEEVENTF_MIDDLEUP = &H40  'Отпустить среднюю кнопку
Private Const MOUSEEVENTF_RIGHTDOWN = &H8  'Нажать правую кнопку
Private Const MOUSEEVENTF_RIGHTUP = &H10  'Отпустить правую кнопку
Private Const MOUSEEVENTF_MOVE = &H1  'Переместить курсор
Private Const MOUSEEVENTF_WHEEL = &H800  'Вращение вертикального колеса мыши (если оно есть)
Private Const MOUSEEVENTF_HWHEEL = &H1000  'То ли вращение горизонтального колеса мыши, толи наклон вправо/влево обыного колеса мыши
Private Const MOUSEEVENTF_XDOWN = &H80  'Нажать на одну из дополнительных кнопок "Х" (номер кнопки задается параметром dwData)
Private Const MOUSEEVENTF_XUP = &H100  'Отпустить  кнопку "Х"
'Дополнительный параметр dwData, определяет поведение функции mouse_event
'при использовании dwFlags = MOUSEEVENTF_WHEEL, MOUSEEVENTF_HWHEEL, MOUSEEVENTF_XDOWN, MOUSEEVENTF_XUP

Наиболее подробная информация о функциональности этих всех параметров содержится на сайте майкрософт (на английском) Например, с помощью параметра MOUSEEVENTF_ABSOLUTE можно задавать координаты мыши с высокой точностью в диапазоне от 0 до 65535 по осям x и y. Правда мне так и не удалось понять, как работает этот параметр, у меня он вобще никакого влияния не оказывал на перемещение курсора, как я только над ним не извращался =)

Помучавшись, обнаружил прекрасную функцию «SetCursorPos», которая так же входит в стандартный набор Виндоус. Она четко ставит укозатель мыши в нужную позицию с координатами, соответствующими разрешению экрана (Например от 0х0 до 1280х800) независимо от настроек чувствительности и ускорения мыши, что очень удобно.

Для работы с медленно прогружающимися объектами (например с сайтами в интернете или тяжеловесными программами) бывает необходимо добавить временную задержку между кликами мыши на различные меню. Поскольку в VBA повидимому нет объекта типа таймера, то вместо него отлично подходит ещё одна стандартная функция Виндовс «Sleep», которая позваляет задавать задержку в милисекундах, что бывает даже удобнее.

Мне необходимо было использовать в своей основной программе две вещи — это перетаскивание объекта из точки 1 в точку 2 и клик мышкой в точке с заданными координатами (например на кнопку). Для реализации каждого из этих действий можно использовать связку из нескольких функций «SetCursorPos» и «mouse_event», но удобнее написать свои процедуры, котарые потом вставлять каждый раз в нужное место, что я и сделал в виде процедур «MouseDragging» и «MouseClick».

Процедура «MouseDragging(x1, y1, x2, y2)» с помощью функции «SetCursorPos(x1, y1)» устанавливает курсор над нужным объектом в координатах (x1, y1), затем с помощью «mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0» нажимает левую кнопку мыши и как бы удерживая её, перетаскивает обект в точку с координатами (x2, y2) с помощью функции «SetCursorPos(x2, y2)». Затем отпускает кнопку мыши с помощью функции «mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0».
С помощью процедуры «MouseDragging(x1, y1, x2, y2)» можно также выделить область текста в Ворде, несколько объектов в Экселе, Автокаде или часть изображения в Пэйнте.

Процедура «MouseClick(x, y)» выполняет клик мышью в точке с координатами (x, y). Сначала устанавливает указатель мыши с помощью функции «SetCursorPos(x, y)» в нужной точке, затем с помощью функции «mouse_event MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP, 0, 0, 0, 0» совершает клик мышью в этой точке. Причем интересно, что запись параметра dwFlags в виде «MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP» сразу же обеспечивает и нажатие левой кнопки мыши и отпускание.

Здесь x, y, x1, y1, x2, y2 играют роль параметров, вместо которых мы при вызове процедур подставляем нужные нам значения.

Теперь вставляем всё это в процедуру нажатия на кнопку Button1, расположенную где-нибудь на нашей форме, и получаем следующее: при нажатии на кнопку происходит задержка 0,5 секунды, затем перетаскивание объекта из координат (889, 490) в точку с координатами (388, 467), затем после задержки в 2,0 секунды выполняется клик мышкой в точке с координатами (768, 419)

Может быть кому-то покажется странным такое длинное описание столь простой задачи, но мне пришлось потратить около месяца времени, чтобы разобраться во всем этом и найти подходящие решения. Надеюсь что данное описание поможет таким же чайникам как я разобраться в этом гораздо быстрее

Источник

iba2004 Пользователь Сообщений: 1034 Регистрация: 22.12.2012	Здравствуйте! Мне необходимо в макросе отловить событие щелчка по ячейке левой кнопкой мыши. Подскажите, пожалуйста, как оно описывается в VBA. По поиску не смог ничего найти. Спасибо!

Юрий М Модератор Сообщений: 60585 Регистрация: 14.09.2012 Контакты см. в профиле	Сработает Worksheet_SelectionChange, но это событие сработает и в том случае, если активируем ячейку каким-либо другим способом.

iba2004

Пользователь

Сообщений: 1034
Регистрация: 22.12.2012

Юрий М,
Спасибо Вам за помощь, но есть нюанс. Мне не хотелось бы что бы событие отрабатывало на выделение ячейки при помощи клавиш клавиатуры, как Вы справедливо заметили, а срабатывало только при нажатии ЛКМ на ячейке.

Изменено: iba2004 — 13.06.2013 10:04:23

ber$erk

Пользователь

Сообщений: 2735
Регистрация: 25.12.2012

13.06.2013 10:14:29

А как такой вариант:
в момент Worksheet_SelectionChange смотреть где находится курсор мыши.

Код

Private Type POINTAPI 
    X As Long 
    Y As Long 
End Type 

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

Private Sub GetRangeFromPoint() 
    Dim iPOINT As POINTAPI, iCell As Range 

    GetCursorPos iPOINT 

    Set iCell = ActiveWindow.RangeFromPoint(X:=iPOINT.X, Y:=iPOINT.Y) 

    If Not iCell Is Nothing Then 
       MsgBox "Курсор мышки находится над " & _ 
       iCell.Address(External:=True), vbExclamation, "" 
    Else 
       MsgBox "Курсор мышки находится вне ячеек рабочего листа", , "" 
    End If 
End Sub

ссыль

и если там где надо, то обрабатывать событие

Учимся сами и помогаем другим…

iba2004

Пользователь

Сообщений: 1034
Регистрация: 22.12.2012

ber$erk,
Простите, если я правильно понял, то описание диапазона в котором должно срабатывать (как у меня сейчас) выделение ячейки по Worksheet_SelectionChange(ByVal Target As Range) у меня описано при помощи If Not Intersect … Is Nothing. А вот то, каким образом мы вошли в этот диапазон: клавишами или ЛКМ я не могу отловить. Или я не о том?
Спасибо Вам за помощь.
Вот нашёл событие Worksheet_BeforeRightClick.
Попробую с ним поковыряться.

Изменено: iba2004 — 13.06.2013 10:28:18

ber$erk Пользователь Сообщений: 2735 Регистрация: 25.12.2012	вот что я хотел сказать Прикрепленные файлы мышка.xlsm (15.97 КБ) Учимся сами и помогаем другим…

Юрий М

Модератор

Сообщений: 60585
Регистрация: 14.09.2012

Контакты см. в профиле

13.06.2013 10:32:25

Цитата
iba2004 пишет: Вот нашёл событие Worksheet_BeforeRightClick .

Там ещё есть ДаблКлик ))

iba2004 Пользователь Сообщений: 1034 Регистрация: 22.12.2012	Юрий М, Да, Вы правы! LeftClick и RightClick различаются. То, что работает по ПКМ, по ЛКМ не хочет.

iba2004 Пользователь Сообщений: 1034 Регистрация: 22.12.2012	ber$erk, ЗдОрово! Простите, что сразу Вас не понял, не хватило знаний. На первый взгляд, действительно то, что мне нужно. Спасибо Вам за помощь. Всех участников топика тоже хочу поблагодарить за помощь. Спасибо!

iba2004

Пользователь

Сообщений: 1034
Регистрация: 22.12.2012

Кажется, сообразил: событие наступает тогда, когда координаты активной ячейки будут совпадать с координатами курсора мыши. Сбои, конечно, возможны, но их процент очень невелик. Спасибо! Но появилась проблема: как в IF описать, что это событие произошло НЕ при помощи нажатия ПКМ, потому как на ПКМ тоже срабатывает? Или необходимо открыть новую тему?
Спасибо!

ber$erk Пользователь Сообщений: 2735 Регистрация: 25.12.2012	На это событие повесить «метку», которая будет говорить, что отрабатывать не надо. Учимся сами и помогаем другим…

iba2004

Пользователь

Сообщений: 1034
Регистрация: 22.12.2012

ber$erk,
У меня на этот счёт есть только одна идея. Макрос Worksheet_BeforeRightClick проставляет в одну из ячеек листа, например, 1 и далее при работе Worksheet_SelectionChange мониторить эту ячейку на предмет наличия в ней 1: если она есть, то событие ПКМ было, если нет – то не было. В том случае, если ход моих мыслей верен и эту проблему нельзя решить по-другому, подскажите, пжл, как можно при нажатии ПКМ и, как следствие, изменении выделенных ячеек, запустить первым для обработки макрос Worksheet_BeforeRightClick, а только затем исполнение Worksheet_SelectionChange? Или это «кривой» путь? Я не могу сообразить как на это событие повесить метку по-другому.
Спасибо!

Изменено: iba2004 — 13.06.2013 18:58:48

ber$erk Пользователь Сообщений: 2735 Регистрация: 25.12.2012	Именно про такой путь я и думал. Оказывается последовательность этих событий не подходит под решение задачи надо думать дальше Учимся сами и помогаем другим…

Юрий М

Модератор

Сообщений: 60585
Регистрация: 14.09.2012

Контакты см. в профиле

#14

13.06.2013 19:26:51

Цитата
iba2004 пишет: запустить первым для обработки макрос Worksheet_BeforeRightClick, а только затем исполнение Worksheet_SelectionChange

Событие SelectionChange наступит раньше. А что Вы к нему «привязались»? Используйте просто ДаблКлик, например.

iba2004 Пользователь Сообщений: 1034 Регистрация: 22.12.2012	Юрий М, Я правильно Вас понял: вместо SelectionChange использовать DoubleClick?

Юрий М

Модератор

Сообщений: 60585
Регистрация: 14.09.2012

Контакты см. в профиле

Ну да! Кликнули дважды по ячейке — наступило событие и выполняются какие-то действия. А если активировали эту ячейку с клавиатуры — ничего не произойдёт. Только перед выходом из процедуры не забудьте написать Cancel = True (отменим режим редактирования в который попадаем при даблклике). Можно и событие правый клик использовать без всякой привязки к SelectionChange.

iba2004 Пользователь Сообщений: 1034 Регистрация: 22.12.2012	#17 13.06.2013 20:25:03 Юрий М, Спасибо! Попробую реализовать.

Источник

This is theoretically possible to do, but you’d have to set a hook for WH_MOUSE_LL messages. The problem is that I seriously doubt that VBA can keep up with the volume of messages that are going to be coming through that pipe. It would be like trying drinking from a fire hose in VBA. If you really want to give it a shot, you can see if this works.

But first:

DISCLAIMER

In all likelihood, Excel will stop responding if you set up this Workbook and open it. It will certainlly stop responding if you open the VBE. Do not put this in a spreadsheet that you can’t afford to delete. Be fully prepared to have to open it with the shift key down to make edits to the code. You have been warned. I take no responsibility for what you do with this. I know better than to have tried it with any code in the event handler. You will likely crash Excel. You will certainly crash the VBE. You may crash anything or everything else.

That should cover it. So…

In a class called HookHolder:

Option Explicit

Private hook As Long

Public Sub SetHook()
    hook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf ClickHook, _
                            0, GetCurrentThreadId)
End Sub

Public Sub UnsetHook()
    'IMPORTANT: You need to release the hook when you're done with it.
    UnhookWindowsHookEx hook
End Sub

In ThisWorkbook:

Option Explicit

Private danger As HookHolder

Private Sub Workbook_Open()
    Set danger = New HookHolder
    danger.SetHook
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    danger.UnsetHook
End Sub

In a Module:

Option Explicit

Public Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Public Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _
        (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, _
        ByVal dwThreadId As Long) As Long
Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Public Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _
        ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long

Public Const HC_ACTION As Long = 0
Public Const WH_MOUSE_LL As Long = &H2
Public Const WM_LBUTTONDOWN As Long = &H201
Public Const WM_LBUTTONUP As Long = &H202
Public Const WM_LBUTTONDBLCLK  As Long = &H203

'Your callback function.
Public Function ClickHook(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    If nCode = HC_ACTION Then
        'Anything in particular you're interest in?
        Select Case wParam
            Case WM_LBUTTONDOWN
                'Do your thing.
            Case WM_LBUTTONUP
                'Do your thing.
            Case WM_LBUTTONDBLCLK
                'Do your thing.
        End Select
    End If
    CallNextHookEx 0, nCode, wParam, ByVal lParam
End Function

Источник

You could use Excel VBA to move the mouse and click on things (left and right click). Below is an example of moving the mouse to the top left of the screen and then clicking. Just copy the code and paste it into macro window in Excel.

The SingleClick() subroutine is a single click, while DoubleClick() subroutine does a double click. The code is quite self explanatory and needs minimal instructions.

Note that SetCursorPos moves the mouse based on the coordinates supplied. The first parameter is the # of pixels to the right from the top left corner of the monitor (x-axis) and the second parameter is the # of pixels below the top left corner of the monitor (y-axis). If the user is using duel monitors, it will be top left corner of the the left most monitor.

Public Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Public 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)
Public Const MOUSEEVENTF_LEFTDOWN = &H2
Public Const MOUSEEVENTF_LEFTUP = &H4
Public Const MOUSEEVENTF_RIGHTDOWN As Long = &H8
Public Const MOUSEEVENTF_RIGHTUP As Long = &H10

Private Sub SingleClick()
  SetCursorPos 100, 100 'x and y position
  mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
  mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
End Sub

Private Sub DoubleClick()
  'Double click as a quick series of two clicks
  SetCursorPos 100, 100 'x and y position
  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

Private Sub RightClick()
  'Right click
  SetCursorPos 200, 200 'x and y position
  mouse_event MOUSEEVENTF_RIGHTDOWN, 0, 0, 0, 0
  mouse_event MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0
End Sub

20 people found this article useful

Источник