Страницы: 1
RSS
Макрос, отключающий движения курсора на пару секунд
 
Добрый день!
Написал код по ходу выполнения которого, чтобы пользователю не было скучно, запускается заставка (обычный скринсейвер).
Заставка автоматом отключается от любого действия пользователя . В том числе движения мышкой в любую сторону.
Такая вот беда - эта заставка в 20% случаев отключается сразу после запуска - из-за инерционного движения мышкой после нажатия кнопки на которую привязан макрос. Т.е. макрос уже работает, а пользователь в это время все еще двигает мышку в области кнопки по инерции.
Мне нужно как-то в коде учесть это.

Пока придумал только пауза 1 секунду выдерживать между нажатием кнопки с макросом и запуском скринсейвера
Application.Wait Time:=Now + TimeValue("0:00:01")

Но мне не нравится это мое решение, секунды мало, а на большую паузу я не согласен - так как запуск заставки через 2-3 секунды от нажатия кнопки смотрится так, словно компьютер еле запустил ее (ощущение что код тормозит).

Выход вижу в коде, отключающем движения мышкой на пару секунд, сразу после нажатия кнопки с макросом.
Но не знаю как его реализовать.
 
Поставить условие на выход. Выходить, если время старта было более 3 секунд назад.
Код
If startTime < Now - TimeSerial(0, 0, 3) Then
 
Мне кажется вы меня не поняли, либо я вас не понял. Мне нужно чтобы скринсейвер не прерывал работу из-за остаточного движения мышкой, после запуска макроса пользователем. Не пойму как прерывание исполнения кода через 3 секунды от нажатия кнопки поможет мне. Да и отложенный запуск скринсейвера на 3 секунды  это слишком много - меня не устраивает. Максимум  через 1 секунду от нажатия кнопки хотелось бы видеть его старт на экране пользователя, а в идеале сразу по нажатию кнопки - и чтобы пользователь его не прерывал случайным движением мыши, когда тыкает кнопку.
Изменено: vikttur - 07.06.2021 13:32:47
 
Может так?
Код
Option Explicit

Declare Function BlockInput Lib "user32" (ByVal fBlock As Long) As Long
Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)

Sub aaa()
    DoEvents
    BlockInput True
    StartScreenSaver
    Sleep 3000
    BlockInput False
End Sub
 
МатросНаЗебре, спасибо Вам большое за помощь! Этот код не подходит для 64-х битной системы, есть универсальное решение?
Чтобы пользователь мог выполнять макрос и на 32 и на 64 битной системе?

P.s. Работоспособность кода ниже проверить не могу - у меня 64-х битная система и я не знаю как переписать строку. Надеюсь сработает)
Правда у меня не предустановленный скринсейвер, а файл ".scr" помещенный кодом в папку C:\Users\Имя пользователя\AppData\Local\Temp
Изменено: Сергей М. - 02.06.2021 15:43:22
 
:(  неужели нет решения моей проблемы, на зависящего от разрядности (32, 64) системы?
 
В #4 строки 3-4 замените на:
Код
#If VBA7 Then
Declare PtrSafe Function BlockInput Lib "user32" (ByVal fBlock As Long) As Long
Declare PtrSafe Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)

#Else
Declare Function BlockInput Lib "user32" (ByVal fBlock As Long) As Long
Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
#End If
Владимир
 
sokol92, приветствую! Спасибо!
Но часть кода подсвечивается красным и выдает ошибку!
(в блоке If тоже красное и тоже ошибка)


 
Изменено: Сергей Юрьевич - 09.06.2021 12:52:01
 
Сергей Юрьевич, вы вызываете процедуру, которой у вас нет, о чём довольно однозначно написано в сообщении об ошибке
Замените StartScreenSaver на название своей процедуры, запускающей скринсейвер
Изменено: Jack Famous - 09.06.2021 12:48:39
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Jack Famous, да, до меня дошло, я подредактировал, но проблему до конца не решил. Отредактировал свое прошлое сообщение (смотрите его)
Кроме того, сам код не блокирует действия мышкой - я могу перемещать курсор сразу после старта макроса (его удается запустить, если закоментировать красные строки кода)
Изменено: Сергей Юрьевич - 09.06.2021 12:59:14
 
Цитата
Сергей Юрьевич написал:
его удается запустить, если закоментировать красные строки кода
Их не надо комментировать. Их надо переписать полностью из сообщения 7, а не частично. Там есть еще такие строки как #IF и т.д. Они ОЧЕНЬ нужны и без них работать не будет.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Цитата
Сергей Юрьевич написал:
я могу перемещать курсор сразу после старта макроса
Можете, но не можете взаимодействовать с Excel (выделить ячейку и т.д.).
Владимир
 
Цитата
sokol92 написал:
Можете, но не можете взаимодействовать с Excel (выделить ячейку и т.д.).
Да, это и является проблемой - скринсейвер по прежнему сбрасывается от движения мышкой пользователем в 20-30% случаев при запуске макроса через кнопку. Так как частенько пользователь не гасит движение мышкой по нажатию кнопки и курсор мышки еще двигается на миллиметр-два и этого достаточно чтобы произошел сброс скринсейвера
Цитата
Дмитрий(The_Prist) Щербаков написал:
Их не надо комментировать. Их надо переписать полностью из сообщения 7, а не частично. Там есть еще такие строки как #IF и т.д. Они ОЧЕНЬ нужны и без них работать не будет.
Спасибо! Понял! Я думал их закоментировали)
Изменено: Сергей Юрьевич - 09.06.2021 15:52:10
 
Понятно. Попробуйте так:
Код
#If VBA7 Then
Declare PtrSafe Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long
Declare PtrSafe Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
#Else
Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long
Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
#End If

Sub HideCursor()
  ShowCursor 0
  Sleep 3000
  ShowCursor 1
End Sub
Владимир
 
Цитата
Сергей М. написал:
чтобы пользователю не было скучно, запускается заставка (обычный скринсейвер)
хорошая идея, я чтоб не было скучно буду запускать переустановку ОС, на соседнем компьютере. А если серьезно, то весьма странная идея. Давайте загрузим проц еще чем либо, пока долгий процесс тарабанит. TКстати а чего он долгий? Бабушка удава прибывает с минуты на минуту?
По вопросам из тем форума, личку не читаю.
 
БМВ, cбор файлов выполняет PQ, запуск из VBA.

Цитата
sokol92 написал: Понятно. Попробуйте так:
Изменено: vikttur - 10.06.2021 13:25:47
 
Сергей Юрьевич, сравните код из #14 и на скрине

P.S.: скрин нужно гораздо сильнее обрезать
Изменено: vikttur - 10.06.2021 13:26:26
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Jack Famous, sokol92, благодарю! Работает!
Страницы: 1
Читают тему (гостей: 1)
Наверх