香港新浪網 MySinaBlog
« 上一篇 | 下一篇 »
Emily | 11th Jan 2006, 21:39 PM | API / Add-in | (1489 Reads)
利用 API 當Excel 閑置時登出電腦

' Module
Option Explicit

Declare Function ExitWindowsEx& Lib "user32" (ByVal uFlags&, ByVal wReserved&)
Global Const EWX_LOGOFF = 0
Dim IdleTime As Date
Dim Action&


Sub StartTimer()
     IdleTime = Now + TimeValue("00:05:00") ' 現在設定 5 分鐘
     Application.OnTime IdleTime, "LogOff"
End Sub

Sub DisableTimer()
     On Error Resume Next
     Application.OnTime EarliestTime:=IdleTime, Procedure:="LogOff", Schedule:=False
End Sub

Sub LogOff()
     Application.DisplayAlerts = False
     Action = ExitWindowsEx(EWX_LOGOFF, 0&)
     Application.Quit
End Sub

' ThisWorkBook
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
     Run "DisableTimer"
     Run "StartTimer"
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Excel.Range)
     Run "DisableTimer"
     Run "StartTimer"
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Run "DisableTimer"
    Run "StartTimer"
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Run "DisableTimer"
End Sub


Last update: 18 Jan 2006