VBA自动每10秒钟保存一次工作簿而不激活工作簿？

我在工作簿打开事件中使用以下vba代码：

Private Sub Workbook_Open() On Error GoTo Message Application.AskToUpdateLinks = False ThisWorkbook.UpdateLinks = xlUpdateLinksNever ActiveSheet.DisplayPageBreaks = False Application.ScreenUpdating = False Application.DisplayAlerts = False Dim currentTime As Date currentTime = DateAdd("s", 10, Now) Call CurUserNames Application.OnTime currentTime, "SaveFile" Exit Sub Message: Application.DisplayAlerts = False Exit Sub End Sub 

我也有这个代码在一个模块中：

 Public Sub SaveFile() On Error GoTo Message ThisWorkbook.Save Dim currentTime As Date currentTime = DateAdd("s", 10, Now) Application.OnTime currentTime, "SaveFile" Exit Sub Message: Application.DisplayAlerts = False Exit Sub End Sub 

我想要做的是每10秒自动保存一次我的工作簿。

这工作。

不过，我注意到一些令人讨厌的事情。 如果用户在后台打开此工作簿并正在处理另一个Excel工作簿，则此工作簿将在保存时激活并显示在其他工作簿之上。

这对用户来说可能很烦人。 有没有办法让我的工作簿保存而不用激活工作簿？

PS：由于某些不明的原因，这也会导致工作簿在closures时重新打开。

编辑：

列出工作簿代码中的活动用户：

 Sub CurUserNames() Dim str As String Dim Val1 As String str = "Users currently online:" & Chr(10) For i = 1 To UBound(ThisWorkbook.UserStatus) str = str & ThisWorkbook.UserStatus(i, 1) & ", " Next Val1 = DeDupeString(Mid(str, 1, Len(str) - 2)) Worksheets("Delivery Tracking").Range("F4").Value = Val1 End Sub Function DeDupeString(ByVal sInput As String, Optional ByVal sDelimiter As String = ",") As String Dim varSection As Variant Dim sTemp As String For Each varSection In Split(sInput, sDelimiter) If InStr(1, sDelimiter & sTemp & sDelimiter, sDelimiter & varSection & sDelimiter, vbTextCompare) = 0 Then sTemp = sTemp & sDelimiter & varSection End If Next varSection DeDupeString = Mid(sTemp, Len(sDelimiter) + 1) End Function 

Answer 1

共享工作簿的用户可以看到Who has this workbook open now:只需转到Ribbon中的“ Review选项卡，然后单击“ Changes组中的“ Shared Workbook图标即可。 这将打开“ Shared Workbook对话框，其中的“ Editing' shows *选项卡Editing' shows *此工作簿现在打开：“*”。 此外，“Advance”标签可用于更新处理设置：

• 跟踪变化
• 更新更改
• 用户之间的冲突变化
• 包括在个人的观点

Answer 2

Th9的例子来自我如何获得使用特定共享工作簿的用户列表？

这是有点矫枉过正。 它会创build一个新的工作簿来放置用户名。但是您可以修改它以将名称放在任何表单中以及您想要的单元格中。

将其放入select更改模块下的工作表模块中。 然后每次用户移动到不同的单元时，它都会更新。 如果它是开放的，他不在他的办公桌上，那什么都不会做。

 Private Sub Worksheet_SelectionChange(ByVal Target As Range) End Sub 

底部是上述链接的代码，您可以根据自己的需要进行修改。 这比每十秒钟保存一个工作簿要好1000倍。 实际上本身可能需要3到4秒。

如果您不想在工作表模块中使用select更改，则可以将代码放入工作簿模块Private Sub Workbook_Open（）中，并将其置于计时器上，每10秒运行一次。 这只需要几分之一秒而不是几秒钟。

 users = ActiveWorkbook.UserStatus With Workbooks.Add.Sheets(1) For row = 1 To UBound(users, 1) .Cells(row, 1) = users(row, 1) .Cells(row, 2) = users(row, 2) Select Case users(row, 3) Case 1 .Cells(row, 3).Value = "Exclusive" Case 2 .Cells(row, 3).Value = "Shared" End Select Next End With