我在工作簿开放事件中使用以下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
答案 0 :(得分:1)
共享工作簿的用户只需转到Who has this workbook open now:
中的Review
标签,然后点击Ribbon
中的Shared Workbook
图标即可看到 Changes
Shared Workbook
组。Editing' shows *
。这将打开script
对话框,其中包含Head
标签,此工作簿现在打开:`*。此外,“Advance”选项卡可用于更新处理的设置:
答案 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