Добрый день. Данный код нужно настроить на горячую клавишу.. Суть макроса навести мышку на картинку и считывать RGB пикселия. Затем кликнуть по этой картинке что бы она была выделена.
Код |
---|
Type POINTAPI x As Long y As Long End Type Private Declare PtrSafe Function GetCursorPos Lib "user32.dll" (ByRef lpPoint As POINTAPI) As Long Private Declare PtrSafe Function CreateDC& Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, lpInitData As Any) Private Declare PtrSafe Function GetPixel Lib "gdi32" (ByVal hDC As LongPtr, ByVal x As Long, ByVal y As Long) As Long Public Declare PtrSafe Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As LongPtr Public 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) Private Const MOUSEEVENTF_LEFTDOWN = &H2 'Íàæàòü ëåâóþ êíîïêó Private Const MOUSEEVENTF_LEFTUP = &H4 'Îòïóñòèòü ëåâóþ êíîïêó Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal milliseconds As Long) Sub RGB_TEST() Dim cpos As POINTAPI Dim obj As Object, NewValue As String GetCursorPos cpos screendc = CreateDC("DISPLAY", "", "", 0&) xm = cpos.x ym = cpos.y lColor = GetPixel(screendc, xm, ym) Red = (lColor Mod 256) Green = (lColor \ 256) Mod 256 Blue = (lColor \ 65536) Mod 256 mouse_event MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP, x, y, 0, 0 ' вот тут макрос перестает быть адекватным!! происходит рассинхрон [a1].select ' выделенная картинка или ячейка мышкой не хочет выделяться End Sub |
короче не знаю что с этим делать....