Страницы: 1
RSS
Сохраниться и выйти в случае бездействия
 
Всем доброго дня!
Пишу макрос в котором нужно сохраниться и выйти через 15 минут в случае бездействия.
Но наткнулась на такой баг: если пользователь начал ввод в ячейку и не закончил его, т.е. курсор мигает в ячейке - нет реакции на Private Sub Workbook_SheetActivate и прочее. И файл висит открытым хоть сто лет. Помогите, пожалуйста, найти действие... при котором такое конкретно бездействие будет считаться бездействием ))... не знаю даже как выразится
Спасибо!
 
В режиме редактирования ячейки никакой макрос  не может быть запущен.
 
vikttur, макрос запускается при открытии книги и считает на фоне время бездействия и если оно превышает 15 минут - сохраняет и закрывает книгу. Получается что ввод в ячейку происходит в процессе работы макроса... Нет возможности обойти такой вариант развития событий?
 
Заморочился с подобным вопросом, надо немного для другой темы.. В общем имеется такой код, который может проверять бездействие и активность. Во время выполнеия можно редактировать книгу (с небльшими лагами). Но есть такой лаг, что если выполнить копирования и следом нажать esc, то макрос вылетает в ошибку - жалуется на api - функцию GetLastInputInfo. Но, что интересно, каким-то образчиком макрос выполняется даже когда курсор внутри ячейки. Специально добавил звуковую пипипку для демонстрации данного эффекта т.ск.
Код
Option Explicit
Private Declare Function BeepApi Lib "kernel32" Alias "Beep" (ByVal FrequencyHz As Long, ByVal TimeMs As Long) As Long
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Declare Function GetLastInputInfo Lib "user32" (plii As Any) As Long
#If VBA7 Then
    Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal milliseconds As LongPtr) 'MS Office 64 Bit
#Else
    Public Declare Sub Sleep Lib "kernel32" (ByVal milliseconds As Long) 'MS Office 32 Bit
#End If
Private Type LASTINPUTINFO
    cbSize As Long
    dwTime As Long
End Type
Public lii  As LASTINPUTINFO
Public t!

Public Sub WaitForActivity()
    Dim tm, i&, old&
    t = Timer
    lii.cbSize = Len(lii)
    GetLastInputInfo lii
    old = lii.dwTime
    Do While lii.dwTime = old 'выход из цикла,при появлении активности
        DoEvents
        Sleep 500
        old = lii.dwTime
        
        Call GetLastInputInfo(lii)
    Loop
    'код при появлении активности
  Debug.Print "Простой: "; Timer - t
    BeepApi 2000, 500
    
  WaitForDowntime
End Sub

Public Sub WaitForDowntime()
    Dim tm, i&
    t = Timer
    lii.cbSize = Len(lii)
        
    Do
        DoEvents
        Sleep 500
        
        Call GetLastInputInfo(lii)
        tm = GetTickCount - lii.dwTime

    Loop Until tm > 6000 'если бездействие дольше 6 выход из цикла
  'код при обнаружении бездействия
  Debug.Print "Активность: "; Timer - t
    BeepApi 800, 700
    
  WaitForActivity
End Sub
Изменено: testuser - 10.10.2022 17:45:53
 
Мы когда-то разбирали работу с таймером.
Владимир
 
sokol92, пожалуй наверное с таймером (SetTimer Lib "user32") можно сделать рабочий вариант для сабжевого случая. Проверил работает без лагов анимации, и без вылета как в выше описанном случае
 
testuser, ну, таймер на АПИ, по моему мнению, нужен только для очень точных замеров. Если точность до пары сотых секунды устраивает, то штатным можно вполне обойтись. Кажется, для вашего случая как раз штатного вполне хватает.
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Jack Famous, проверил, штатный не работатет, когда курсор в ячейке, видимо, поскольку он функция приложения.
 
Цитата
testuser: когда курсор в ячейке
не вдавался в подробности, но из ячейки можно выйти программно. Не думаю, что замена таймера тут поможет. Могу ошибаться.
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Страницы: 1
Наверх