VBA自动保存工作簿每10秒不激活工作簿?

时间:2017-03-02 10:57:41

标签: excel vba excel-vba

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

这对用户来说非常烦人。 有没有办法在不激活工作簿的情况下保存工作簿?

P.S: 由于某些未知原因,这也会导致工作簿在关闭时重新打开。

编辑:

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

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

2 个答案:

答案 0 :(得分:1)

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

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

enter image description here

答案 1 :(得分:0)

Th9示例来自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