Question

代码的目的是查看计算机是否空闲。如果经过了足够的时间，则它会首先警告该文件将要保存，然后如果没有其他时间响应以自动保存该文件。但是，空闲计时器无法触发我的任何潜水艇。在我自动保存之前，它就可以正常工作。

这是我在ThisWorkbook中的代码，可自动运行我的3个潜水艇。

Option Explicit

Sub Workbook_Open()
    IdleTime
    WarningMessage
    CloseDownFile
End Sub

由于CloseDownFile实际上并没有关闭文件，所以命名有点少，但我只是从未更改过名称。

这是运行良好的代码：

Private Type LASTINPUTINFO
    cbSize As Long
    dwTime As Long
End Type

Private Declare Sub GetLastInputInfo Lib "user32" (ByRef plii As LASTINPUTINFO)

Private Declare Function GetTickCount Lib "kernel32" () As Long

Function IdleTime() As Single
    Dim a As LASTINPUTINFO
    a.cbSize = LenB(a)
    GetLastInputInfo a
    IdleTime = (GetTickCount - a.dwTime) / 1000
End Function

Public Sub CloseDownFile()
    On Error Resume Next
    If IdleTime > 30 Then
        Application.StatusBar = "Inactive File Closed: " & ThisWorkbook.Name
        ThisWorkbook.Save
    Else
        CloseDownTime = Now + TimeValue("00:00:30") ' change as needed
        Application.OnTime CloseDownTime, "CloseDownFile"
    End If
End Sub

这是我在模块1中的3个主要子代码，这些子代码源于运行良好但现在计时器不起作用的那段代码。另外，既然Option Explicit启用了，就是说未定义CloseDownTime：

Option Explicit

Private Type LASTINPUTINFO
    cbSize As Long
    dwTime As Long
End Type

Private Declare Sub GetLastInputInfo Lib "user32" (ByRef plii As LASTINPUTINFO)

Private Declare Function GetTickCount Lib "kernel32" () As Long

Function IdleTime() As Single
    Dim a As LASTINPUTINFO
    a.cbSize = LenB(a)
    GetLastInputInfo a
    IdleTime = (GetTickCount - a.dwTime) / 1000
End Function

Public Sub CloseDownFile()
    On Error Resume Next

    If IdleTime > 30 Then
        Application.StatusBar = "Inactive File Closed: " & ThisWorkbook.Name
        ThisWorkbook.Save
    Else
        CloseDownTime = Now + TimeValue("00:00:30") ' change as needed
        Application.OnTime CloseDownTime, "CloseDownFile"
    End If
End Sub

Public Sub WarningMessage()
    On Error Resume Next

    If IdleTime > 20 Then
        Application.StatusBar = "Saving File" & ThisWorkbook.Name
        ShowForm     
    End If
End Sub

这是WarningMessage调用的ShowForm子项：

Option Explicit

Public Sub ShowForm()
    Dim frm As New UserForm1
    frm.BackColor = rgbBlue

    frm.Show
End Sub

这是在Userform1中运行的代码：

Private Sub CommandButton1_Click()
    Hide
    m_Cancelled = True
    MsgBox "Just Checking!"

    CloseDownTime = Now + TimeValue("00:00:30")
    Application.OnTime CloseDownTime, "WarningMessage"
End Sub

Private Sub Image1_Click()
End Sub

Private Sub CommandButton2_Click()
    Hide
    m_Cancelled = True
    MsgBox "Then how did you respond?"

    CloseDownTime = Now + TimeValue("00:00:30")
    Application.OnTime CloseDownTime, "WarningMessage"
End Sub

Private Sub TextBox1_Change()
End Sub

Answer 1

我认为问题与在If IdleTime > 30 Then部分中您不再重新启动Application.OnTime来继续检查过程有关。另外，由于计时器设置为30秒，因此到达该子菜单时，它总是大于30秒。因此它将不会继续检查。

看看像这样构造代码是否有帮助。

Option Explicit

Private Type LASTINPUTINFO
  cbSize As Long
  dwTime As Long
End Type

Public Declare Sub GetLastInputInfo Lib "user32" (ByRef plii As LASTINPUTINFO)
Public Declare Function GetTickCount Lib "kernel32" () As Long

Public Function IdleTime() As Long
    Dim LastInput As LASTINPUTINFO
    LastInput.cbSize = LenB(LastInput)
    GetLastInputInfo LastInput
    IdleTime = (GetTickCount - LastInput.dwTime) \ 1000
End Function

Public Sub CloseDownFile()
    Dim CloseDownTime As Date

    Debug.Print "Going here IdleTime is " & IdleTime

    If IdleTime > 30 Then
        Debug.Print "Saving"
        Application.StatusBar = "Inactive File Closed: " & ThisWorkbook.Name
        ThisWorkbook.Save
    End If

    'You always want to run this code to keep checking
    CloseDownTime = Now + TimeValue("00:00:15")
    Application.OnTime CloseDownTime, "CloseDownFile"
End Sub

Public Sub WarningMessage()
    If IdleTime > 20 Then
        Application.StatusBar = "Saving File" & ThisWorkbook.Name
        ShowForm
    End If
End Sub

Public Sub ShowForm()
    Dim frm As UserForm1: Set frm = New UserForm1
    frm.BackColor = rgbBlue
    frm.Show
 End Sub

空闲计时器未触发操作

1 个答案: