0

代码的目标是查看计算机是否空闲。如果有足够的时间过去，则首先发出文件即将保存的警告，然后如果再过一段时间没有响应，则自动保存文件。但是，空闲计时器无法触发我的任何潜艇。当我刚刚自动保存时，它可以工作。

这是我在 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
4

1 回答 1

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
于 2019-01-04T13:57:22.683 回答