Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Указатель мыши в точку координат курсора - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Указатель мыши в точку координат курсора (Макросы/Sub)
Указатель мыши в точку координат курсора
auto-teacher Дата: Суббота, 29.10.2016, 01:53 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 9
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Как сделать такой макрос, чтобы указатель мыши из любого места переместился туда, где стоит курсор?
Например, есть пример макроса с конкретными числами:
[vba]
Код
Private Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
' Устанавливаем координаты курсора в точку (300, 600)
Call SetCursorPos(300, 600)
[/vba]

А надо, чтобы в него вставились текущие координаты курсора.

Есть еще один макрос, определяющий координаты курсора:
[vba]
Код
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

Private Type POINTAPI
X As Long
Y As Long
End Type

Dim z As POINTAPI

Private Sub Timer1_Timer()
GetCursorPos z
Label1 = "x: " & z.X
Label2 = "y: " & z.Y
End Sub

Private Sub Form_Load()
Timer1.Interval = 1
End Sub
[/vba]

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


Auto-Teacher

Сообщение отредактировал auto-teacher - Суббота, 29.10.2016, 02:10
 
Ответить
СообщениеКак сделать такой макрос, чтобы указатель мыши из любого места переместился туда, где стоит курсор?
Например, есть пример макроса с конкретными числами:
[vba]
Код
Private Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
' Устанавливаем координаты курсора в точку (300, 600)
Call SetCursorPos(300, 600)
[/vba]

А надо, чтобы в него вставились текущие координаты курсора.

Есть еще один макрос, определяющий координаты курсора:
[vba]
Код
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

Private Type POINTAPI
X As Long
Y As Long
End Type

Dim z As POINTAPI

Private Sub Timer1_Timer()
GetCursorPos z
Label1 = "x: " & z.X
Label2 = "y: " & z.Y
End Sub

Private Sub Form_Load()
Timer1.Interval = 1
End Sub
[/vba]

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

Автор - auto-teacher
Дата добавления - 29.10.2016 в 01:53
krosav4ig Дата: Суббота, 29.10.2016, 04:56 | Сообщение № 2
Группа: Друзья
Ранг: Старожил
Сообщений: 1340
Репутация: 536 ±
Замечаний: 0% ±

Excel 2007, 2013
курсор

что конкретно понимаете под этим словом?
GetCursorPos определяет XY координаты указателя мыши относительно верхнего левого угла рабочего стола(экрана)


(_)Õvõ(_)

Сообщение отредактировал krosav4ig - Суббота, 29.10.2016, 04:59
 
Ответить
Сообщение
курсор

что конкретно понимаете под этим словом?
GetCursorPos определяет XY координаты указателя мыши относительно верхнего левого угла рабочего стола(экрана)

Автор - krosav4ig
Дата добавления - 29.10.2016 в 04:56
auto-teacher Дата: Понедельник, 31.10.2016, 14:36 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 9
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Спасибо за внимание! Подсказали - задачка решена.


Auto-Teacher
 
Ответить
СообщениеСпасибо за внимание! Подсказали - задачка решена.

Автор - auto-teacher
Дата добавления - 31.10.2016 в 14:36
Pelena Дата: Понедельник, 31.10.2016, 14:38 | Сообщение № 4
Группа: Модераторы
Ранг: Экселист
Сообщений: 9842
Репутация: 2252 ±
Замечаний: 0% ±

Excel 2010 & Mac Excel 2011
auto-teacher, поделитесь решением, кому-нибудь может пригодиться


"Черт возьми, Холмс! Но как??!!"
ЯД 41001765434816
 
Ответить
Сообщениеauto-teacher, поделитесь решением, кому-нибудь может пригодиться

Автор - Pelena
Дата добавления - 31.10.2016 в 14:38
auto-teacher Дата: Пятница, 25.11.2016, 21:13 | Сообщение № 5
Группа: Пользователи
Ранг: Прохожий
Сообщений: 9
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Pelena!
Хорошо, пришлю.
Чтобы понять, зачем все это было нужно, требуется пояснение.
Если в доке есть сноска, ссылка или примечание, то при наведении на них указателя мыши всплывает подсказка.
Переходы по этим объектам я делаю горячими клавишами, используя штатные команды типа GoToNextFootnote.
Мне захотелось, чтобы подсказка всплыла без наведения указателя сразу после нахождения следующей сноски, то есть, автоматом.
Благодаря советам знатоков с нескольких форумов удалось решить несколько задач для достижения этой цели, создать макросы и даже обогатить их диалогами.
Перечислю по шагам используемые команды на обычном, человечьем языке (коды приведу на днях, потому что их надо привести в порядок для удобного понимания и потому, что там есть неожиданно найденное решение для использования самозакрывающихся диалоговых окон от Andrew Baker).
1) След. сноска.
2) Если сносок нет - сообщение, что их нет. (Закрывать окно не требуется, потому что оно гаснет через секунду).
3) Если курсор ниже последней сноски - сообщение с предложением искать выше. (Закрывать окно не требуется, потому что оно гаснет через секунду).
4) Если есть - переход курсора к след. сноске.
5) Если сноска последняя - сообщение об этом. (Закрывать окно не требуется, потому что оно гаснет через секунду).
6) Нахождение координат курсора.
7) Перевод указателя мыши на координаты курсора. (После этого перехода подсказка не всплывает.)
8) Имитация движения указателя мыши над сноской или, проще говоря, сдвиг указателя с найденных координат курсора на несколько пикселей вниз или в сторону. Как ни странно, эта мультипликация подействовала. Для этого применен цикл по таймеру системы. (Могу похвастаться, что это меня самого так осенило).
9) Подсказка всплывает и макрос заканчивается.

Продолжение следует...


Auto-Teacher
 
Ответить
СообщениеPelena!
Хорошо, пришлю.
Чтобы понять, зачем все это было нужно, требуется пояснение.
Если в доке есть сноска, ссылка или примечание, то при наведении на них указателя мыши всплывает подсказка.
Переходы по этим объектам я делаю горячими клавишами, используя штатные команды типа GoToNextFootnote.
Мне захотелось, чтобы подсказка всплыла без наведения указателя сразу после нахождения следующей сноски, то есть, автоматом.
Благодаря советам знатоков с нескольких форумов удалось решить несколько задач для достижения этой цели, создать макросы и даже обогатить их диалогами.
Перечислю по шагам используемые команды на обычном, человечьем языке (коды приведу на днях, потому что их надо привести в порядок для удобного понимания и потому, что там есть неожиданно найденное решение для использования самозакрывающихся диалоговых окон от Andrew Baker).
1) След. сноска.
2) Если сносок нет - сообщение, что их нет. (Закрывать окно не требуется, потому что оно гаснет через секунду).
3) Если курсор ниже последней сноски - сообщение с предложением искать выше. (Закрывать окно не требуется, потому что оно гаснет через секунду).
4) Если есть - переход курсора к след. сноске.
5) Если сноска последняя - сообщение об этом. (Закрывать окно не требуется, потому что оно гаснет через секунду).
6) Нахождение координат курсора.
7) Перевод указателя мыши на координаты курсора. (После этого перехода подсказка не всплывает.)
8) Имитация движения указателя мыши над сноской или, проще говоря, сдвиг указателя с найденных координат курсора на несколько пикселей вниз или в сторону. Как ни странно, эта мультипликация подействовала. Для этого применен цикл по таймеру системы. (Могу похвастаться, что это меня самого так осенило).
9) Подсказка всплывает и макрос заканчивается.

Продолжение следует...

Автор - auto-teacher
Дата добавления - 25.11.2016 в 21:13
auto-teacher Дата: Пятница, 25.11.2016, 22:12 | Сообщение № 6
Группа: Пользователи
Ранг: Прохожий
Сообщений: 9
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Как известно, для просмотра и редактирования сносок, гиперссылок и примечаний есть встроенные макросы. Если это делать с ленты - то долго и нудно.
Автоматизации добиться можно только горячими клавишами.

Такие у меня стоят объявления (или как вы их там у себя называете) в модуле NewMacros (сверху - для курсора):

[vba]
Код

Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
Private Type POINTAPI
X As Long
Y As Long
End Type

Public lRetVal As VbMsgBoxResult ' Постоянная часть процедуры всплывающего и гаснущего сообщения. См. модуль Messaging
Const interval As Long = 2500 ' Сообщения по умолчанию будут отображаться это время (в мсек), если не будут остановлены нажатием [ОК]. Можно ввести в конкретное сообщение число миллисекунд цифрами
[/vba]
____________________________________________________________________________
Такая должна быть макрокоманда (цикл по таймеру - моя фантазия), остальное все с форумов:

[vba]
Код

Sub СноскаОбычнаяСлед()
Dim cX As Long, cY As Long, i As Byte
If ActiveDocument.Footnotes.Count = 0 Then
        lRetVal = MsgboxOKDrop("Обычных сносок еще никто не вставил!" & vbCrLf & _
        "Возможно, есть концевые сноски!", vbOKOnly + vbInformation, "Отсутствие сносок в тексте", interval)
    ElseIf Selection.StoryType = wdFootnotesStory Then ' Для концевых выбран другой вариант выделения
        Application.Run "GoToNextFootnote"
    Else ' Если курсор в основном тексте
        Application.Run "GoToNextFootnote"
            ActiveWindow.GetPoint cX, cY, 0&, 0&, Selection.Range
                For i = 0 To 2
                    SetCursorPos cX + i, cY + i
                    Dim Start
                    Start = Timer ' текущее время в секундах
                    Do While Timer < Start + 0.05
                    Loop
                Next i
Set R = Selection.Range
    If (R.Start <> Selection.Start) Or (R.END <> Selection.END) Then
    ElseIf Selection.Characters.First.Footnotes.Count <= 0 Then
        lRetVal = MsgboxOKDrop("Ниже сносок больше нет!" & vbCrLf & _
        "Попробуй поискать вверх!", vbOKOnly + vbInformation, "Проверка сносок", interval)
        Exit Sub
    End If
Dim F As Footnote
    Set F = Selection.Characters.First.Footnotes(1)
    ' наличие следующей сноски
    Set R = Selection.Range.GoTo(What:=wdGoToFootnote, Which:=wdGoToNext, Count:=1)
    If R.Start <= Selection.Start Then
        lRetVal = MsgboxOKDrop("Это последняя сноска в тексте!" & vbCrLf & _
        "Дальше можно не искать!", vbOKOnly + vbInformation, "Проверка сносок", interval)
    End If
    End If
End Sub
[/vba]


Auto-Teacher

Сообщение отредактировал auto-teacher - Пятница, 25.11.2016, 22:28
 
Ответить
СообщениеКак известно, для просмотра и редактирования сносок, гиперссылок и примечаний есть встроенные макросы. Если это делать с ленты - то долго и нудно.
Автоматизации добиться можно только горячими клавишами.

Такие у меня стоят объявления (или как вы их там у себя называете) в модуле NewMacros (сверху - для курсора):

[vba]
Код

Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
Private Type POINTAPI
X As Long
Y As Long
End Type

Public lRetVal As VbMsgBoxResult ' Постоянная часть процедуры всплывающего и гаснущего сообщения. См. модуль Messaging
Const interval As Long = 2500 ' Сообщения по умолчанию будут отображаться это время (в мсек), если не будут остановлены нажатием [ОК]. Можно ввести в конкретное сообщение число миллисекунд цифрами
[/vba]
____________________________________________________________________________
Такая должна быть макрокоманда (цикл по таймеру - моя фантазия), остальное все с форумов:

[vba]
Код

Sub СноскаОбычнаяСлед()
Dim cX As Long, cY As Long, i As Byte
If ActiveDocument.Footnotes.Count = 0 Then
        lRetVal = MsgboxOKDrop("Обычных сносок еще никто не вставил!" & vbCrLf & _
        "Возможно, есть концевые сноски!", vbOKOnly + vbInformation, "Отсутствие сносок в тексте", interval)
    ElseIf Selection.StoryType = wdFootnotesStory Then ' Для концевых выбран другой вариант выделения
        Application.Run "GoToNextFootnote"
    Else ' Если курсор в основном тексте
        Application.Run "GoToNextFootnote"
            ActiveWindow.GetPoint cX, cY, 0&, 0&, Selection.Range
                For i = 0 To 2
                    SetCursorPos cX + i, cY + i
                    Dim Start
                    Start = Timer ' текущее время в секундах
                    Do While Timer < Start + 0.05
                    Loop
                Next i
Set R = Selection.Range
    If (R.Start <> Selection.Start) Or (R.END <> Selection.END) Then
    ElseIf Selection.Characters.First.Footnotes.Count <= 0 Then
        lRetVal = MsgboxOKDrop("Ниже сносок больше нет!" & vbCrLf & _
        "Попробуй поискать вверх!", vbOKOnly + vbInformation, "Проверка сносок", interval)
        Exit Sub
    End If
Dim F As Footnote
    Set F = Selection.Characters.First.Footnotes(1)
    ' наличие следующей сноски
    Set R = Selection.Range.GoTo(What:=wdGoToFootnote, Which:=wdGoToNext, Count:=1)
    If R.Start <= Selection.Start Then
        lRetVal = MsgboxOKDrop("Это последняя сноска в тексте!" & vbCrLf & _
        "Дальше можно не искать!", vbOKOnly + vbInformation, "Проверка сносок", interval)
    End If
    End If
End Sub
[/vba]

Автор - auto-teacher
Дата добавления - 25.11.2016 в 22:12
auto-teacher Дата: Пятница, 25.11.2016, 22:13 | Сообщение № 7
Группа: Пользователи
Ранг: Прохожий
Сообщений: 9
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
А это особый модуль гаснущего сообщения:

[vba]
Код

'To display a timed Msgbox use the MsgboxOKDrop routine given below.
'By Andrew Baker

Option Explicit

'API calls for Msgbox2. Must be placed in a standard module
Private Declare Function SetTimer Lib "user32" (ByVal Hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal Hwnd As Long, ByVal nIDEvent As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal Hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Any) As Long
Private zsMessageTitle As String, lTimerId As Long

'Purpose     :  Stops the timer routine
'Inputs      :  N/A
'Outputs     :  Returns True if the timer routine was stopped
'Author      :  Andrew Baker
'Date        :  15/10/2000 15:24
'Notes       :  Code must be placed in a module
'Revisions   :

Function EndTimer() As Boolean
    If lTimerId Then
        lTimerId = KillTimer(0&, lTimerId)
        lTimerId = 0
        EndTimer = True
    End If
End Function

'Purpose     :  Starts the continuous calling of a private routine at a specific time interval.
'Inputs      :  lInterval           The interval (in ms) at which to call the routine
'Outputs     :  N/A
'Author      :  Andrew Baker
'Date        :  15/10/2000 15:30
'Notes       :  Code must be placed in a module
'Revisions   :

Sub StartTimer(lInterval As Long)
    If lTimerId Then
        'End Current Timer
        EndTimer
    End If
    lTimerId = SetTimer(0&, 0&, ByVal lInterval, AddressOf TimerRoutine)
End Sub

'Purpose     :  Routine which is called repeatedly by the timer API.
'Inputs      :  Inputs are automatically generated.
'Outputs     :
'Author      :  Andrew Baker
'Date        :  15/10/2000 15:32
'Notes       :
'Revisions   :

Private Sub TimerRoutine(ByVal lHwnd As Long, ByVal lMsg As Long, ByVal lIDEvent As Long, ByVal lTime As Long)
    Const WM_CLOSE = &H10
    Dim lHwndMsgbox As Long

    'Find the Msgbox
    lHwndMsgbox = FindWindow(vbNullString, zsMessageTitle)
    'Close Msgbox
    Call SendMessage(lHwndMsgbox, WM_CLOSE, 0, ByVal 0&)
End Sub

'Purpose     :  Extended version of Msgbox, has extra parameter to set time msgbox is displayed for
'Inputs      :  As per Msgbox
'               [DisplayTime]               The time in MS to display the message.
'Outputs     :  As per Msgbox
'Author      :  Andrew Baker
'Date        :  03/01/2001 13:23
'Notes       :
'Revisions   :

Function MsgboxOKDrop(Prompt As String, Buttons As VbMsgBoxStyle, Title As String, Optional DisplayTime As Long = 3000) As VbMsgBoxResult
    If DisplayTime > 0 Then
        'Enable the timer
        StartTimer DisplayTime
        zsMessageTitle = Title
    End If
    MsgboxOKDrop = MsgBox(Prompt, Buttons, Title)
    'Stop the timer
    EndTimer
End Function
[/vba]

Если кому непонятно, как все это применить для гиперссылок и примечаний, - пришлю все, что у меня есть: полный набор макросов.


Auto-Teacher
 
Ответить
СообщениеА это особый модуль гаснущего сообщения:

[vba]
Код

'To display a timed Msgbox use the MsgboxOKDrop routine given below.
'By Andrew Baker

Option Explicit

'API calls for Msgbox2. Must be placed in a standard module
Private Declare Function SetTimer Lib "user32" (ByVal Hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal Hwnd As Long, ByVal nIDEvent As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal Hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Any) As Long
Private zsMessageTitle As String, lTimerId As Long

'Purpose     :  Stops the timer routine
'Inputs      :  N/A
'Outputs     :  Returns True if the timer routine was stopped
'Author      :  Andrew Baker
'Date        :  15/10/2000 15:24
'Notes       :  Code must be placed in a module
'Revisions   :

Function EndTimer() As Boolean
    If lTimerId Then
        lTimerId = KillTimer(0&, lTimerId)
        lTimerId = 0
        EndTimer = True
    End If
End Function

'Purpose     :  Starts the continuous calling of a private routine at a specific time interval.
'Inputs      :  lInterval           The interval (in ms) at which to call the routine
'Outputs     :  N/A
'Author      :  Andrew Baker
'Date        :  15/10/2000 15:30
'Notes       :  Code must be placed in a module
'Revisions   :

Sub StartTimer(lInterval As Long)
    If lTimerId Then
        'End Current Timer
        EndTimer
    End If
    lTimerId = SetTimer(0&, 0&, ByVal lInterval, AddressOf TimerRoutine)
End Sub

'Purpose     :  Routine which is called repeatedly by the timer API.
'Inputs      :  Inputs are automatically generated.
'Outputs     :
'Author      :  Andrew Baker
'Date        :  15/10/2000 15:32
'Notes       :
'Revisions   :

Private Sub TimerRoutine(ByVal lHwnd As Long, ByVal lMsg As Long, ByVal lIDEvent As Long, ByVal lTime As Long)
    Const WM_CLOSE = &H10
    Dim lHwndMsgbox As Long

    'Find the Msgbox
    lHwndMsgbox = FindWindow(vbNullString, zsMessageTitle)
    'Close Msgbox
    Call SendMessage(lHwndMsgbox, WM_CLOSE, 0, ByVal 0&)
End Sub

'Purpose     :  Extended version of Msgbox, has extra parameter to set time msgbox is displayed for
'Inputs      :  As per Msgbox
'               [DisplayTime]               The time in MS to display the message.
'Outputs     :  As per Msgbox
'Author      :  Andrew Baker
'Date        :  03/01/2001 13:23
'Notes       :
'Revisions   :

Function MsgboxOKDrop(Prompt As String, Buttons As VbMsgBoxStyle, Title As String, Optional DisplayTime As Long = 3000) As VbMsgBoxResult
    If DisplayTime > 0 Then
        'Enable the timer
        StartTimer DisplayTime
        zsMessageTitle = Title
    End If
    MsgboxOKDrop = MsgBox(Prompt, Buttons, Title)
    'Stop the timer
    EndTimer
End Function
[/vba]

Если кому непонятно, как все это применить для гиперссылок и примечаний, - пришлю все, что у меня есть: полный набор макросов.

Автор - auto-teacher
Дата добавления - 25.11.2016 в 22:13
auto-teacher Дата: Пятница, 25.11.2016, 22:30 | Сообщение № 8
Группа: Пользователи
Ранг: Прохожий
Сообщений: 9
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Пояснение.
Код цикла я, естественно, тоже где-то сдул. Фантазией было - применить его для имитации движения мыши.
Если кто-то знает, как "шевельнуть" мышь правильным способом - прошу сообщить.


Auto-Teacher
 
Ответить
СообщениеПояснение.
Код цикла я, естественно, тоже где-то сдул. Фантазией было - применить его для имитации движения мыши.
Если кто-то знает, как "шевельнуть" мышь правильным способом - прошу сообщить.

Автор - auto-teacher
Дата добавления - 25.11.2016 в 22:30
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Указатель мыши в точку координат курсора (Макросы/Sub)
Страница 1 из 11
Поиск:

Яндекс цитирования
© 2010-2016 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!