【发布时间】：2019-10-09 22:06:34
【问题描述】：
我正在处理一个启用宏的 Excel 文件，我希望它像时间表一样工作。用户将按下一个按钮，当前时间将被标记在开始列中；如果用户再次按下它，当前时间将被标记在完成列中。如果用户启动了一个循环，并且 PC 在没有用户交互的情况下运行了 5 分钟，则循环将结束，时间将自动标记在完成单元格中。当循环开始时，会运行 5 分钟的计时器。如果在 5 分钟计时器结束之前没有 PC 活动，则会标记时间并结束循环。 该代码检测 PC 不活动，而不仅仅是在 Excel 中。
当我打开或处理另一个工作簿时，宏/计时器停止。即使我正在处理另一个 Excel 文件，我也需要宏继续运行。
我尝试了 DoEvents 解决方法，但没有成功。我读到在使用 Workbook.Open 时存在错误，但我没有在我的任何模块中使用 Workbook.Open。当我打开另一个 Excel 文件时，只需在我的桌面上找到该文件并双击它。
我一直在尝试声明一个全局变量来获取和存储工作表的名称（因为其他人会复制并使用它，所以很可能会更改工作表的名称）因为我感觉这与我识别活动单元格的代码有关。
表 1
Dim mRg As Range
Dim mStr As String
Private Sub Worksheet_Change(ByVal Target As Range)
Dim WorkRng As Range
Dim Rng As Range
Dim xOffsetColumn As Integer
Set WorkRng = Intersect(Application.ActiveSheet.Range("A:A"), Target)
xOffsetColumn = 5
If Not WorkRng Is Nothing Then
Application.EnableEvents = False
For Each Rng In WorkRng
If Not VBA.IsEmpty(Rng.Value) Then
Rng.Offset(0, xOffsetColumn).Value = Date
Else
Rng.Offset(0, xOffsetColumn).ClearContents
End If
Next
Application.EnableEvents = True
End If
'Locking the entire third column with a password
Dim xRg As Range
On Error Resume Next
Set xRg = Intersect(Range("C:C"), Target)
If xRg Is Nothing Then Exit Sub
Target.Worksheet.Unprotect Password:="password"
If xRg.Value <> mStr Then xRg.Locked = True
Target.Worksheet.Protect Password:="password"
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Range("C:C"), Target) Is Nothing Then
Set mRg = Target.Item(1)
mStr = mRg.Value
End If
End Sub
这本工作簿
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim lA As Long
'Last non-blank cell of column A (Start)
Dim lB As Long
'Last non-blank cell of column B (Finish)
lA = Cells(Rows.Count, 1).End(xlUp).Row
lB = Cells(Rows.Count, 2).End(xlUp).Row
If lA <> lB Then
'If there's an unfinished cycle, execute the following:
Call Range_End_Method
Call TimeStartStop
ThisWorkbook.Save
Application.DisplayAlerts = False
End If
If lA = lB Then
'If there's no unfinished cycle, save the sheet and immediately close the sheet
ThisWorkbook.Save
Application.DisplayAlerts = False
End If
End Sub
模块 1
Option Explicit
Sub Range_End_Method()
'Finds the last non-blank cell in a single row or column
Dim FirstBlankCell As Range
Set FirstBlankCell = Range("B" & Rows.Count).End(xlUp).Offset(1, 0)
FirstBlankCell.Activate
End Sub
模块2
Private Type LASTINPUTINFO
cbSize As Long
dwTime As Long
End Type
Private Declare PtrSafe Function GetLastInputInfo Lib "user32" (lii As LASTINPUTINFO) As Long
Private Declare PtrSafe Function GetTickCount Lib "kernel32" () As Long
'Getting number of seconds idle/user inactivity on PC, not just Excel
Private Function GetIdleSecs()
Dim LastInput As LASTINPUTINFO
With LastInput
.cbSize = Len(LastInput)
Call GetLastInputInfo(LastInput)
GetIdleSecs = (GetTickCount() - .dwTime) / 1000
End With
End Function
Public Sub checkIdle()
Dim lA As Long
'Last non-blank cell of column A (Start)
Dim lB As Long
'Last non-blank cell of column B (Finish)
lA = Cells(Rows.Count, 1).End(xlUp).Row
lB = Cells(Rows.Count, 2).End(xlUp).Row
'If block for if the sheet is blank
If lA = 4 Then
lA = 6
End If
If lB = 4 Then
lB = 6
End If
DoEvents
'Number of seconds idle
Dim idleSecs As Long: idleSecs = GetIdleSecs()
If lA <> lB Then
'If there's a running cycle, execute the following
'For Debugging purposes; this shows up in the immediate Window which you can open by pressing Ctrl + G
Debug.Print "Idle for"; idleSecs
'If number of seconds idle is less than 5 minutes, the timer will continue counting and updating every second
If idleSecs < 300 Then
Application.OnTime Now + TimeValue("00:00:01"), "checkIdle", False
End If
'idleSecs is the number of seconds needed before the whole If Block is executed
'300 seconds because 5 minutes x 60 seconds
If idleSecs = 300 Then
Call Module1.Range_End_Method
Call Module3.TimeStartStop
'Save the current workbook
ThisWorkbook.Save
'Message box: First parameter is the message body, third parameter is the alert title
MsgBox "TMS has stopped due to 5 minutes of inactivity. Your workbook has automatically been updated and saved.", , "TMS Stopped"
'Sub is automatically closed once 5 minutes is reached and the timer is stopped
Exit Sub
End If
End If
If lA = lB Then
'If there's no running cycle, execute the following:
'For debugging purposes
'Debug.Print "Doing nothing..."
End If
End Sub
Public Sub doNothing()
'For debugging purposes
'Debug.Print "Doing nothing..."
End Sub
模块3
Sub TimeStartStop()
CR = ActiveCell.Row
CC = ActiveCell.Column
If CC <= 2 And CR >= 6 Then
TS = ThisWorkbook.ActiveSheet.Name
ThisWorkbook.Sheets(TS).Cells(CR, CC) = Now
ThisWorkbook.Sheets(TS).Cells(CR, CC + 1).Select
If CC = 2 And ThisWorkbook.Sheets(TS).Cells(CR, 1) <> "" Then
ActiveCell.FormulaR1C1 = _
"=IFS(RC[-2] = """","""",((RC[-1]-RC[-2])*24*60)<0,"""",(RC[-1]-RC[-2])*24*60,(RC[-1]-RC[-2])*24*60)"
'ThisWorkbook.ActiveSheet.Cells(CR, 3) = _
' (ThisWorkbook.ActiveSheet.Cells(CR, 2) - ThisWorkbook.ActiveSheet.Cells(CR, 1)) * 24 * 60
ThisWorkbook.Sheets(TS).Cells(CR + 1, CC - 1).Select
End If
End If
End Sub
模块4
Sub StartStopButtonClick()
'Macro assigned to the Start/Stop button. Automatically executes the TimeStartStop and checkIdle subs upon being clicked
Dim lA As Long
'Last non-blank cell of column A (Start)
Dim lB As Long
'Last non-blank cell of column B (Finish)
Dim lC As Long
'The next blank cell right below lA
lA = Cells(Rows.Count, 1).End(xlUp).Row
lB = Cells(Rows.Count, 2).End(xlUp).Row
lC = lA + 1
If lA = 4 Then
'For a completely blank file
lA = 6
lB = 6
Cells(lA, 1).Select
ElseIf lA <> lB Then
'If there's an unfinished cycle, go to the Finish cell
Cells(lA, 2).Select
ElseIf lA = lB Then
'If there are no running cycles, go to the next empty Start cell
Cells(lC, 1).Select
Else:
Debug.Print "Call Tech Support"
End If
'Execute the following modules:
Call Module3.TimeStartStop
Call Module2.checkIdle
End Sub
This is how the worksheet looks.
一旦通过宏（使用开始和结束时间计算周期时间）将数据输入其中，C 列（周期时间）中的单元格应该被锁定。
诚然，删除/删除行是一件令人头疼的事情。我必须制作一份用户手册作为这样做的指南。
一切正常，只是当我切换到另一个 Excel 文件（即使它以前打开过）时，计时器停止。
即使用户切换到另一个 Excel 文件或打开一个新的 Excel 文件，我也希望宏继续运行。
非常感谢！
【问题讨论】：
-
您应该尝试从您的代码中消除每个“ActiveSheet”和“ActiveCell”。我不知道这是否是唯一的问题，但你总是会遇到依赖于它的代码的问题。
-
@Jochen 即将提出类似的建议...
Application.ActiveSheet.Range....将始终是您当前的活动工作表（即：您在屏幕上或上次选择的任何工作表），所以如果您打开一个新工作簿，您的活动表将在新工作簿中。如果你完全限定范围，你不应该有问题。为此，您始终可以使用ThisWorkbook，它返回存储宏的工作簿（假设是同一个工作簿）。完全限定范围意味着几乎所有以Range...、Cells...、ActiveSheet...、ActiveCell...开头的内容。