当我关闭工作簿时,如果其他人也打开了它,它会再次打开



很抱歉标题混淆了。但是,如果某个文件被其他人打开,当我打开它时,我会收到一条消息,说它是由其他人打开的,我可以选择在无法保存的情况下打开它。
如果我在关闭文件时选择该选项,它会自动重新打开。

该文件有一些宏,这很可能是原因,但我不明白它是如何导致这个问题的。

首先。该文件的模块中有一个非活动跟踪器,每五秒钟运行一次:

Private Type LASTINPUTINFO
cbSize As Long
dwTime As Long
End Type
#If VBA7 Then
Private Declare PtrSafe Function GetTickCount Lib "kernel32" () As Long
Private Declare PtrSafe Sub GetLastInputInfo Lib "User32" (ByRef plii As LASTINPUTINFO)
#Else
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Declare Sub GetLastInputInfo Lib "User32" (ByRef plii As LASTINPUTINFO)
#End If
Public tid As Variant
Public lista As Scripting.Dictionary

Function IdleTime() As Single
Dim a As LASTINPUTINFO
a.cbSize = LenB(a)
GetLastInputInfo a
IdleTime = (GetTickCount - a.dwTime) / 1000
End Function
Sub Form_Timer()

' lookup the inaktivity time for current user if 0
If tid = 0 Then
LR = ThisWorkbook.Sheets("Inaktivitet").Cells(ThisWorkbook.Sheets("Inaktivitet").Rows.Count, "B").End(xlUp).Row
tid = Application.VLookup(UCase(Environ("UserName")), ThisWorkbook.Sheets("Inaktivitet").Range("B17:G" & LR), 6, False)
If Not IsError(tid) Then
tid = tid * 60
Else
' if user does not have a specified inactivity time set the "other" time to user
tid = Application.VLookup("Övriga", ThisWorkbook.Sheets("Inaktivitet").Range("B17:G" & LR), 6, False)
tid = tid * 60
End If
End If



tme = IdleTime
'Debug.Print tme & " " & Now()

' display warning when less than 65 seconds
If tid - tme < 65 Then
UserForm2.Show vbModeless
DoEvents
End If

If tme >= tid Then
If lista.Exists(UCase(Environ("UserName"))) Then ThisWorkbook.Save
Application.DisplayAlerts = False
ThisWorkbook.Close
End If
On Error Resume Next
Application.OnTime RunTime, "Form_Timer", Schedule:=False
Application.OnTime Now + TimeSerial(0, 0, 5), "Form_Timer"
End Sub

此代码是通过下面的工作簿打开事件启动的。创建的字典是将不活动时间(和写入权限(保存在字典中;不能"在没有保存权限的情况下被操纵。

Public RunTime
Private Sub Workbook_Open()
Set lista = New Scripting.Dictionary
For I = 18 To ThisWorkbook.Sheets("Inaktivitet").Range("B200").End(xlUp).Row
If ThisWorkbook.Sheets("Inaktivitet").Range("B" & I).Value <> "" And ThisWorkbook.Sheets("Inaktivitet").Range("B" & I).Value <> "Övriga" Then
lista.Add Key:=ThisWorkbook.Sheets("Inaktivitet").Range("B" & I).Value, Item:=ThisWorkbook.Sheets("Inaktivitet").Range("C" & I).Value
End If
Next I

Application.Calculation = xlCalculationManual  ' This is done to make the workbook more responsive due to other event macros
Form_Timer   ' <----  Here
End Sub

在BeforeSave中,我确保用户名在字典中,否则不允许保存。在BeforeClose中,我关闭了不活动跟踪器,并将计算设置为自动:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Application.OnTime RunTime, "Form_Timer", Schedule:=False
Application.Calculation = xlAutomatic
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
On Error GoTo err
If Not lista.Exists(UCase(Environ("UserName"))) Then
Cancel = True
MsgBox "Du har inte behörighet att spara schemat" ' you don't have permissions to save.

End If
GoTo subend:


err:
MsgBox "Något har gått fel, det går inte spara." & vbNewLine & "filen går in i felsäkert läge nu. Kopiera celler/blad som är ändrade till en ny excelfil och spara den." & vbNewLine & "Stäng därefter alla Excelfiler innan du försöker öppna någon Excelfil igen."
Application.EnableEvents = False

subend:
On Error GoTo 0
End Sub

当用户更改活动工作簿时,计算将切换:但我怀疑这是原因。

Private Sub Workbook_WindowActivate(ByVal Wn As Window)
If Wn.Caption = ThisWorkbook.Name Then
Application.Calculation = xlCalculationManual
Else
Application.Calculation = xlCalculationAutomatic
End If
End Sub
Private Sub Workbook_WindowDeactivate(ByVal Wn As Window)
Application.Calculation = xlCalculationAutomatic
End Sub

运行的其余宏是SheetChange、SheetActive和SheetSelectionChange代码,用于为图纸上的文本着色,以帮助用户并显示各种消息。

我认为问题在于非活动计时器,由于某种原因,它在工作簿关闭后再次运行,从而打开工作簿执行此操作。
或者您是否看到其他原因导致工作簿再次自动打开?只有当其他人有写权限,而我没有写权限打开它时,才会发生这种情况
当我关闭工作簿时,我会问我是否要保存更改,然后按"否"。
这应该关闭非活动计时器,然后关闭它,然后停止。至少在我看来。

我知道非活动计时器可以由技术人员关闭,并且使用字典的写入权限不是100%安全的,但这不是故意的。

问题是RunTime变量没有在非活动计时器中更新
我错过了那个部分。

当前不活动(sub-Form_timer(((代码以结尾

If tme >= tid Then
If lista.Exists(UCase(Environ("UserName"))) Then ThisWorkbook.Save
Application.DisplayAlerts = False
ThisWorkbook.Close
End If
On Error Resume Next
Application.OnTime RunTime, "Form_Timer", Schedule:=False
Application.OnTime Now + TimeSerial(0, 0, 5), "Form_Timer"
End Sub

应该是:

If tme >= tid Then
If lista.Exists(UCase(Environ("UserName"))) Then ThisWorkbook.Save
Application.DisplayAlerts = False
ThisWorkbook.Close
End If
On Error Resume Next
Application.OnTime RunTime, "Form_Timer", Schedule:=False
RunTime = Now + TimeSerial(0, 0, 5)
Application.OnTime RunTime, "Form_Timer"
End Sub

这可以确保我正确设置了运行时间,以便可以使用BeforeSave事件取消它。

最新更新