☰

跟踪用户打开表单时的用户名和日期戳

tag-icon • tag-icon microsoft-excel-2010 macros
跟踪用户打开表单时的用户名和日期戳

我已经在 VBA 代码表中写入了以下代码。

Private Sub Workbook_Open() MsgBox ("欢迎使用 Tracker，" & Application.UserName) End Sub

结果是“欢迎来到 Tracker，Sakaray，Kiran”

当用户打开工作表时，我想在其中一张工作表中跟踪以下详细信息。

用户名日期和时间变更

请帮助我。谢谢

答案1

我在其他地方找到了这个问题的答案，但我现在找不到那个参考资料，所以我将给你我目前正在使用的解决方案。对于我的项目，我希望每次用户打开工作簿时都会填充 UserAccess 工作表，但您可以轻松修改它以在每次用户访问工作表时更新工作表，如下所述。

如果您想要用户的 Excel 用户名，Application.UserName 就可以了。如果您想要他的 Windows 用户名，您必须在模块中放置一个函数来获取 Windows 用户名：

Declare PtrSafe Function Get_User_Name Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

然后在 ThisWorkbook 中放入以下函数

Private Sub Workbook_Open()
    Dim wsTemp As Worksheet
    Dim bFound As Boolean
    Dim NxRow As Integer

    'First check to see if the UserAccess sheet exists
    For Each wsTemp In Worksheets
        If wsTemp.Name Like "UserAccess" Then bFound = True: Exit For
    Next

    'If it doesn't exist, add it
    If bFound = False Then Sheets.Add.Name = "UserAccess"

    With Sheets("UserAccess")
        'I like to keep this sheet protected from users editing it, so I unprotect it here first
        .Unprotect "t/c,Anm.QXz;D#9KL@Z$"

        'Find the last empty row on this sheet
        NxRow = .Cells(65536, 1).End(xlUp).Row + 1

        'Fill the cells with data
        .Cells(NxRow, 1).Value = Module1.GetUserName 'this is from the function in Module1
        .Cells(NxRow, 2).Value = DateTime.Now

        'Re-protect the sheet
        .Protect "t/c,Anm.QXz;D#9KL@Z$", UserInterfaceOnly:=True
    End With
End Sub

如果您希望在访问工作表时运行宏（正如您在问题中提到的那样），您可以修改上述函数并将其放在 VBA 中的工作表代码区域中：

Private Sub Worksheet_Activate()    
    Dim NxRow As Integer

    With ActiveSheet
        'Find the last empty row on this sheet
        NxRow = .Cells(65536, 1).End(xlUp).Row + 1

        'Fill the rows with data
        .Cells(NxRow, 1).Value = Application.UserName
        .Cells(NxRow, 2).Value = DateTime.Now
    End With
End Sub

相关内容