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

【问题标题】：VBA Auto Save workbook every 10 seconds without activating workbook?VBA每10秒自动保存工作簿而不激活工作簿？
【发布时间】：2023-04-05 18:53:01
【问题描述】：

我在工作簿打开事件中使用以下 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 工作簿，则此工作簿将在保存时激活并显示在另一个工作簿之上。

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

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

编辑：

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

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

【问题讨论】：

10 秒非常频繁，为什么不添加一个条件来查看工作簿是否真的处于活动状态，否则跳过保存？这样，如果工作簿实际发生更改，它将处于活动状态，然后每 10 秒保存一次。出于兴趣，为什么如此频繁？
@Wolfie 我需要经常使用它，因为用户可以访问工作簿，因为它是共享的，并且在单元格中我列出了所有活动用户。但是，除非经常保存工作簿，否则不会更新
回复：未知原因：除非您在Workbook_Close 事件触发时清除了OnTime 事件计划，否则它将重新打开它以继续计划。有数百个示例说明如何执行此操作。此外，与其每 10 秒盲目地保存文件，为什么不先测试是否发生了变化，如果发生了则保存？如果文件已更改，ThisWorkbook.Saved 将设置为 False。
我同意@CLR，这个问题很可能有更好的攻角，比如“换页”事件加上一个计时器。首先，我希望这本工作手册很小，而且您的网络速度很快，因为即使每 10 秒自动保存一秒钟，生产力也会下降 10%！
该工作簿是通过 VBa 从其他工作簿打开的吗？

标签： vba excel

【解决方案1】：

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

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

【讨论】：

【解决方案2】：

Th9is 示例来自How can I get list of users using specific shared workbook?

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

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

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

End Sub

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

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

【讨论】：