Показать последний раз, когда пользователь открыл общую книгу в vba - PullRequest
0 голосов
/ 28 сентября 2018

У меня есть общая таблица, которую могут открыть несколько пользователей.Я хочу иметь отдельную вкладку со всеми пользователями таблицы и их последним временем открытия.

Во-первых, возможно ли это?Я слышал, что у общих рабочих листов есть ограничения, у меня есть альтернативные идеи по этому поводу, но этот способ был бы наилучшим.

Я еще ничего не пробовал, поэтому извиняюсь за отсутствие кода, но если кто-то может указать мне направильное направление, это будет высоко ценится.

Спасибо!

Ответы [ 2 ]

0 голосов
/ 28 сентября 2018

Версия 2: Нет объекта ListObject

Это вариант моего первоначального ответа.Похоже, что объекты ListObject могут быть несовместимы с общими книгами, поэтому этот просто помещает данные на чистый лист.

Option Explicit

Private Sub Workbook_Open()

    Dim sh As Worksheet
    Dim nextRow As Integer

    Set sh = getSheet("TrackOpen")

    'Make the sheet if it doesnt already exist
    If sh Is Nothing Then
        Set sh = ThisWorkbook.Worksheets.Add
        With sh
            .Name = "TrackOpen"
            .Range("A1") = "User"
            .Range("B1") = "Timestamp"
            .Range("A1:B1").Font.Bold = True
        End With
    End If

    With sh
        nextRow = sh.Range("A" & sh.Rows.Count).End(xlUp).Row + 1
        sh.Range("A" & nextRow) = Environ("Username")
        sh.Range("B" & nextRow) = Now()
    End With

    'Optional, uncomment to save
    'ThisWorkbook.Save

End Sub

Private Function getSheet(sheetName As String) As Worksheet
    On Error GoTo uhoh
    Set getSheet = ThisWorkbook.Sheets(sheetName)
    Exit Function
uhoh:
    Set getSheet = Nothing
End Function
0 голосов
/ 28 сентября 2018

Это вполне возможно.

Поместите это в модуль рабочей книги, а затем вручную запустите метод Workbook_Open.

enter image description here

Option Explicit

Private Sub Workbook_Open()

    Dim sh As Worksheet
    Dim objList As ListObject
    Dim listRow As listRow

    Set sh = getSheet("TrackOpen")

    'Make the sheet if it doesnt already exist
    If sh Is Nothing Then
        Set sh = ThisWorkbook.Worksheets.Add
        sh.name = "TrackOpen"
    End If

    Set objList = getListObject("TBL_Logins")

    'Make the table if it doesn't already exist
    If objList Is Nothing Then
        Set objList = ThisWorkbook.Sheets("TrackOpen").ListObjects.Add
        With objList
            .name = "TBL_Logins"
            .ListColumns.Add
            .ListColumns(1).name = "User"
            .ListColumns(2).name = "Timestamp"
        End With
    End If

    Set listRow = objList.ListRows.Add
    With listRow
        .Range(1, objList.ListColumns("User").Index) = Environ("Username")
        .Range(1, objList.ListColumns("Timestamp").Index) = Now()
    End With

    'Optional, uncomment to save
    'ThisWorkbook.Save

End Sub

Private Function getSheet(sheetName As String) As Worksheet
    On Error GoTo uhoh
    Set getSheet = ThisWorkbook.Sheets(sheetName)
    Exit Function
uhoh:
    Set getSheet = Nothing
End Function

Private Function getListObject(listName As String) As ListObject
    Dim sh As Worksheet
    Dim lst As ListObject
    On Error GoTo uhoh
    For Each sh In ThisWorkbook.Sheets
        For Each lst In sh.ListObjects
            If lst.name = listName Then Set getListObject = lst: Exit Function
        Next lst
    Next sh
uhoh:
    Set getListObject = Nothing
End Function
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...