Private Type POINTAPI
X As Long
Y As Long
End Type
Private Declare Function GetCursorPos _
Lib "user32.ddl" (IpPoint As POINTAPI) As Long
Sub Auto_Open()
GetCursorPosition
End Sub
Private Sub GetCursorPosition()
Dim oPOINT As POINTAPI, pauseTime, Start, Finish, TotalTime
Application.DisplayAlerts = True 'Разрешаем предупреждения на время работы
GetCursorPos IPoint 'запрашиваем позицию курсора
Xx = IPoint.X
Yy = IPoint.Y
pauseTime = 10 ' время в секундах
Start = Timer 'Старт
Do While Timer < Start + pauseTime 'Запускаем цикл таймера
DoEvents 'Выход на другие процессы
Loop
Finish = Timer 'Время вышло
TotalTime = Finish - Start 'Подсчет времени простоя
GetCursorPos IPoint 'Запрашиваем позицию курсора
Xx2 = IPoint.X
Yy2 = IPoint.Y
If Xx = Xx2 And Yy = Yy2 Then 'Сравниваем 1 и 2 положение курсора
'Начинаем действия при простое
If ActiveWorkbook.ReadOnly Then 'проверяем файл на "Только чтение"
Excel.ActiveSheet.Cells(1, 1).Select 'переходим на ячейку 1,1 для устранения не оконченного ввода
Application.DisplayAlerts = False 'подавляем предупреждения
Aplication.Quit ' Закрываем приложение
ActiveWorkbook.Close True
Application.DisplayAlerts = True 'Разрешаем предупреждения на время работы
Else
Application.DisplayAlerts = False 'подавляем предупреждения
Excel.ActiveWorkbook.Save 'сохраняем активную книгу
Aplication.Quit ' Закрываем приложение
ActiveWorkbook.Close True
Application.DisplayAlerts = True 'Разрешаем предупреждения на время работы
End If
End
Else
'тут пользователь двигал курсор
End If
cicle 'переходим к процедуре цикла
End Sub
Private Sub cicle()
GetCursorPosition 'Зацикливаем процедуру пока не будет бездействия юзера
End Sub
Взял я его отсюда. Попробовал применить не получается...может что-то не то сделал... создал модуль в него вставил. не работает. может кто подскажет как его запустить, чтобы он работал?
Подскажите как его применить? что куда правильно вставить чтобы он работал?
этот макрос работает если в принципе не двигать мышку. а если эксель файл сейчас открыт, но не активен, а я работаю в другой программе он почему-то не закрывает файл. можно это исправить ? спасибо
ИМХО все это - из пушки по воробьям. Можно по ontime проверять файл на saved и сохранять каждый раз. В очередной раз проверки, если saved=true закрывать файло. Для безопасности можно при открытии создавать бэкап-копию.
А в этом коде обязательно отслеживать ОБЕ координаты курсора? Может достаточно следить только за одной из них? Ибо практически невозможно сдвинуть мышь, чтобы X или Y оставались константой.
jack_21, А в чем смысл такой оптимизации? Да и сдвинуть только по одной координате возможно, например при помощи трэк-поинт или просто по кромке экрана. В целом если с разницей в 10 сек, курсор будет оказываться в одном конкретном из углов экрана, то это простой, хотя между может что-то происходить.
А если в Xx = записывать ActiveCell.Address, то отслеживаться будет адрес текущей ячейки в excel. И тогда действия юзера в другом приложении не влияет на таймер.
Скрытый текст
Код
Private Sub GetCursorPosition()
Dim PauseTime, Start, Finish, TotalTime
Application.DisplayAlerts = True ' Разрешаем предупреждения на время работы
'GetCursorPos iPOINT ' Запрашиваем позицию курсора и записываем в переменные
Xx = ActiveCell.Address
'Yy = iPOINT.Y
PauseTime = 300 ' Время в секундах (60=1 мин)
Start = Timer ' Старт
Do While Timer < Start + PauseTime ' Запускаем цикл таймера
DoEvents ' Выход на другие процессы
Loop
Finish = Timer ' Время вышло.
TotalTime = Finish - Start ' Подсчет времени простоя
'GetCursorPos iPOINT ' Запрашиваем позицию курсора и записываем в другие переменные
Xx2 = ActiveCell.Address
'Yy2 = iPOINT.Y
If Xx = Xx2 Then ' Сравниваем 1 и 2 положение курсора
' Начинаем действия при простое
If ActiveWorkbook.ReadOnly Then ' Проверяем файл на "ТОЛЬКО ЧТЕНИЕ"
Excel.ActiveSheet.Cells(1, 1).Select ' Переходим на ячейку 1,1 для устранения неоконченного ввода
Application.DisplayAlerts = False ' Подавляем предупреждения
'Application.Quit ' Закрываем приложение
ActiveWorkbook.Close True
Application.DisplayAlerts = True
Else
Application.DisplayAlerts = False ' Подавляем предупреждения
Excel.ActiveWorkbook.Save ' Сохраняем активную книгу
'Application.Quit ' Закрываем приложение
ActiveWorkbook.Close True
Application.DisplayAlerts = True
End If
End
Else
' Тут пользователь двигал курсор
End If
Cicle ' Переходим к процедуре цыкла
End Sub
Классная идея! А как использовать данный код? Попробовал вставить его в модуль, а в модуль книги вставил его вызов при открытии. Но выдает ошибку функция не определена.