宏记录用户已阅读文档

时间:2016-01-22 11:16:12

标签: vba excel-vba ms-word excel

道歉,如果在其他地方得到回答,但我已经搜索过,无法找到任何内容。

我被要求创建一种跟踪用户何时阅读我们的政策文件并进行记录的方法。我最初的想法是在策略文档的底部(单词中)有一个宏按钮,用户单击该按钮以确认他们已阅读它。然后,这将更新Excel电子表格,然后插入一个新行,捕获用户名,文档名称和时间戳。

然后,团队可以查看谁已经阅读了什么等,并在最新的时候删除excel线。 excel当然会保存在静态位置。

不幸的是,我的VB技能非常小,所以我不知道从哪里开始。可以这样做吗?有人可以帮忙吗?

1 个答案:

答案 0 :(得分:2)

你可以尝试下面的

Sub save_tracking()
Dim XLapp As Excel.Application
Dim xlWB As Excel.Workbook
Set XLapp = New Excel.Application

'turn off extra bits
Screen_ = XLapp.ScreenUpdating
XLapp.ScreenUpdating = False
Event_ = XLapp.EnableEvents
XLapp.EnableEvents = False
Alerts_ = XLapp.DisplayAlerts
XLapp.DisplayAlerts = False

'get username
un = Environ("username")

'open tracking workbook
Set xlWB = XLapp.Workbooks.Open("C:\Test Tacking.xlsx", False, False)

'save information
With xlWB.Sheets(1)
    If .Range("A2").Value = "" Then
    'no values yet
        .Range("A2").Value = un
        .Range("B2").Value = XLapp.Name
        .Range("C2").Value = Now()
    ElseIf .Range("A3").Value = "" Then
    '2nd
        .Range("A3").Value = un
        .Range("B3").Value = XLapp.Name
        .Range("C3").Value = Now()
    Else
    '>2 values
        .Range("A2").End(xlDown).Offset(1, 0).Value = un
        .Range("B2").End(xlDown).Offset(1, 0).Value = XLapp.Name
        .Range("C2").End(xlDown).Offset(1, 0).Value = Now()
    End If
End With

'restore settings to previous
XLapp.ScreenUpdating = Screen_
XLapp.EnableEvents = Event_
XLapp.DisplayAlerts = Alerts_

'save/close workbook
xlWB.Close True
XLapp.Quit
Set XLapp = Nothing


End Sub

Function Environ(Expression)
On Error GoTo Err_Environ

    Environ = VBA.Environ(Expression)

Exit_Environ:
    Exit Function

Err_Environ:
    MsgBox Err.Number & " - " & Err.Description
    Resume Exit_Environ

End Function

将xlWB的文件名更改为存储跟踪表的位置。在跟踪表中,A1 / B1 / C1保留用于标题,信息将存储在第一张表中。

编辑:修改为从另一个办公室程序运行。您需要参考" Microsoft Excel 12.0对象库"版本可能不同但应该没问题。工具 - >引用。带你到参考文献