记录打开Excel文件的人员

记录打开Excel文件的人员,excel,logging,trace,vba,Excel,Logging,Trace,Vba,下面的代码正是我想要的。。它保留了打开我的excel文件的人的记录,但问题是它使文件对所有人都开放 我希望此选项卡在后台工作,因此当我转到后端或单击某个按钮使其可见时,除我之外,其他人都看不到它 请不要只是在标签审核可见的情况下,代码必须始终检查标签是否打开,并在有人打开文件时立即隐藏 提前谢谢 Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" ( _ ByVal lpBuffer A

下面的代码正是我想要的。。它保留了打开我的excel文件的人的记录,但问题是它使文件对所有人都开放

我希望此选项卡在后台工作,因此当我转到后端或单击某个按钮使其可见时,除我之外,其他人都看不到它

请不要只是在标签审核可见的情况下,代码必须始终检查标签是否打开,并在有人打开文件时立即隐藏

提前谢谢

Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" ( _
    ByVal lpBuffer As String, _
    nSize As Long) As Long
Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" ( _
    ByVal lpBuffer As String, _
    nSize As Long) As Long

Private pAuditSheet As Worksheet
Private Const USERNAME_COL = 1
Private Const COMPUTERNAME_COL = 2
Private Const OPEN_TIME_COL = 3
Private Const CLOSE_TIME_COL = 4
Private Const OPEN_WB_NAME_COL = 5
Private Const CLOSE_WB_NAME_COL = 6
Private Const KEEP_ONLY_LAST_N_ENTRIES = 1

Private Sub Workbook_Open()
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' Workbook_Open
    ' Runs when the workbook is opened.
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

   Me.Worksheets("Audit").Protect UserInterfaceOnly:=True

   Dim WS As Worksheet
    Dim RowNum As Long
    Dim N As Long
    Dim S As String

    Application.ScreenUpdating = False
    On Error Resume Next
    Err.Clear
    Set WS = Me.Worksheets("Audit")
    If Err.Number = 9 Then
        Set WS = Me.Worksheets.Add(before:=1)
        WS.Name = "Audit"
    End If
    On Error GoTo 0
    With WS
        If .Cells(1, USERNAME_COL).Value = vbNullString Then
            .Cells(1, USERNAME_COL).Value = "User Name"
            .Cells(1, COMPUTERNAME_COL).Value = "Computer Name"
            .Cells(1, OPEN_TIME_COL).Value = "Open Time"
            .Cells(1, CLOSE_TIME_COL).Value = "Close Time"
            .Cells(1, OPEN_WB_NAME_COL).Value = "Open WB Name"
            .Cells(1, CLOSE_WB_NAME_COL).Value = "Close WB Name"
        End If
        '.Visible = xlSheetVeryHidden
        RowNum = .Cells(.Rows.Count, USERNAME_COL).End(xlUp)(2, 1).Row
        N = 255
        S = String(N, vbNullChar)
        N = GetUserName(S, N)
        .Cells(RowNum, USERNAME_COL).Value = TrimToNull(S)
        N = 255
        S = String(N, vbNullChar)
        N = GetComputerName(S, N)
        .Cells(RowNum, COMPUTERNAME_COL).Value = TrimToNull(S)
        .Cells(RowNum, OPEN_TIME_COL).Value = Now
        ' Leave Close Time empty. It will be filled on close.
        .Cells(RowNum, CLOSE_TIME_COL).Value = vbNullString
        .Cells(RowNum, OPEN_WB_NAME_COL).Value = ThisWorkbook.FullName
        ' Leave Close Name empty. It will be filled on close.
        .Cells(RowNum, CLOSE_WB_NAME_COL).Value = vbNullString
        .UsedRange.Columns.AutoFit
    End With
    Application.ScreenUpdating = True
End Sub


Private Sub Workbook_BeforeClose(Cancel As Boolean)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Workbook_BeforeClose
' Runs when the workbook is closed.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim WS As Worksheet
    Dim RowNum As Long
    Dim EndRow As Long
    Dim LastDel As Long
    Dim FirstDel As Long

    Application.ScreenUpdating = False
    Set WS = Worksheets("Audit")
    With WS
        RowNum = .Cells(.Rows.Count, CLOSE_TIME_COL).End(xlUp).Row + 1
        .Cells(RowNum, CLOSE_TIME_COL).Value = Now
        .Cells(RowNum, CLOSE_WB_NAME_COL).Value = ThisWorkbook.FullName
        .UsedRange.Columns.AutoFit
        If KEEP_ONLY_LAST_N_ENTRIES > 0 Then
            EndRow = .Cells(.Rows.Count, USERNAME_COL).End(xlUp).Row
            If EndRow > 2 Then
                FirstDel = 2
                LastDel = EndRow - KEEP_ONLY_LAST_N_ENTRIES
                If LastDel > 2 Then
                    .Cells(FirstDel, "A").Resize(LastDel - 1, 1).Select
                End If
            End If
        End If
    End With

    Application.ScreenUpdating = True
End Sub


Private Function TrimToNull(S As String) As String
'''''''''''''''''''''''''''''''''''''''''''''''''''
' TrimToNull
' Returns the portion of string S that is to the
' left of the vbNullChar, Chr(0).
'''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim N As Long
    N = InStr(1, S, vbNullChar)
    If N = 0 Then
        TrimToNull = S
    Else
        TrimToNull = Left(S, N - 1)
    End If
End Function

如果取消对该行的注释,您可能会发现


.Visible=xlSheetVeryHiddenI可能会在您不知情的情况下使用LibreOffice或Gnumeric打开您的电子表格。