我在一本书中找到了代码:
Option Explicit
Sub SaveAndCLose()
Application.DisplayAlerts = False
Tabelle1.Range("A1").Value = _
"Last Edition " & Now & " from User " & Environ("Username")
ThisWorkbook.Close Savechanges:=True
Application.DisplayAlerts = True
End Sub
是否可以记录最近的10次编辑。例如:今天USER X已编辑-Range("A1")
。第二天,对该文件的每个版本进行了另一次Range("A2")
编辑,依此类推。
我知道在Excel Audit Trail中没有实现,但是简单的代码提供了进行最后编辑的信息。
或者也许有更好的方法为Excel文件实施审核跟踪?
答案 0 :(得分:1)
一个简单的简单代码可能是以下代码
Option Explicit
Const X = "X"
Sub SaveAndClose()
Dim rgB As Range
Dim rowX As Long
Dim auditTxt As String
Set rgB = Tabelle1.Range("B1:B10")
auditTxt = "Last Edition " & Now & " from User " & Environ("Username")
rowX = findXA(rgB)
'rowX = findX(rgB)
If rowX = 0 Then
Tabelle1.Cells(1, 1).Value = auditTxt
Tabelle1.Cells(1, 2).Value = X
ElseIf rowX = 10 Then
Tabelle1.Cells(1, 1).Value = auditTxt
Tabelle1.Cells(1, 2).Value = X
Tabelle1.Cells(rowX, 2).ClearContents
Else
Tabelle1.Cells(rowX + 1, 1).Value = auditTxt
Tabelle1.Cells(rowX + 1, 2).Value = X
Tabelle1.Cells(rowX, 2).ClearContents
End If
'' I commented this part of the code for testing purposes
'' Uncomment to save and close the file
' Application.DisplayAlerts = False
' ThisWorkbook.Close Savechanges:=True
' Application.DisplayAlerts = True
End Sub
Function findX(rg As Range) As Long
' find the X by putting the range into an array and looping through it
Dim vDat As Variant
Dim i As Long
findX = 0
vDat = WorksheetFunction.Transpose(rg)
For i = LBound(vDat) To UBound(vDat)
If UCase(vDat(i)) = X Then
findX = i
Exit Function
End If
Next
End Function
Function findXA(rg As Range) As Long
' find the X by usind ragne.find
Dim rgX As Range
Set rgX = rg.Find(X, , , , , , False)
If rgX Is Nothing Then
findXA = 0
Else
findXA = rgX.Row
End If
End Function