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

VBA Auto Save workbook every 10 seconds without activating workbook?

提问by user7415328

I am using the following vba code in a workbook open event:

我在工作簿打开事件中使用以下 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

I also have this code in a module:

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

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

What I am trying to do is automatically save my workbook every 10 seconds.

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

This works.

这有效。

However, something quite annoying I've noticed happens. If a user has this workbook open in the background and is working on another excel workbook then this workbook will activate and display on top of the other workbook when saving.

但是，我注意到发生了一些非常烦人的事情。如果用户在后台打开此工作簿并且正在处理另一个 Excel 工作簿，则该工作簿将在保存时激活并显示在另一个工作簿的顶部。

This can be quite annoying for the user. Is there a way I can get my workbook to save without activating the workbook?

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

P.S: For some unknown reason, this also causes the workbook to reopen when its been closed.

PS：由于某些未知原因，这也会导致工作簿在关闭时重新打开。

EDIT:

编辑：

List active users in workbook code:

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

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

回答by EEM

Users of a shared workbook can see Who has this workbook open now:just by going to the Reviewtab in the Ribbonand click the Shared Workbookicon in the Changesgroup. This will open the Shared Workbookdialog box, in it the tab Editing' shows *Who has this workbook open now:`*. Additionally the tab 'Advance' can be used to update the settings dealing with:

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

• Track changes
• Update changes
• Conflicting changes between users
• Include in personal view

• 跟踪变化
• 更新更改
• 用户之间的冲突更改
• 包含在个人视图中

回答by John Muggins

Th9is example comes from How can I get list of users using specific shared workbook?

Th9is 示例来自如何使用特定共享工作簿获取用户列表？

It is a little overkill. It creates a new workbook to put the users name in. But you can modify it to put the names in whatever sheet and whatever cells you want.

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

Put it in the sheet module under the selection change module. Then it will update every time the user moves to a different cell. If it is open and he's not at his desk - it doesn't do anything.

将其放在选择更改模块下的工作表模块中。然后每次用户移动到不同的单元格时它都会更新。如果它打开并且他不在办公桌前 - 它不会做任何事情。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

End Sub

At the bottom is the code from the above link that you can modify to suit your own needs. It will be 1000 times better than saving a workbook every ten seconds. Which can actually take 3 or 4 seconds itself.

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

If you don't want to use selection change in the worksheet module then you could put your code into the workbook module Private Sub Workbook_Open() and put it on a timer to run every 10 seconds. It will only take a fraction of a second instead of several seconds.

如果您不想在工作表模块中使用选择更改，那么您可以将代码放入工作簿模块 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