工作簿上次编辑时的文档

时间:2018-08-11 07:56:05

标签: excel vba

我在一本书中找到了代码:

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文件实施审核跟踪?

1 个答案:

答案 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

代码使用col A和B,并在最后写的一行中将X放入col B中。我希望这可能不是一个“聪明”的代码,但IMO很容易理解 enter image description here