VBA codes showing the list of users who open the shared workbook
VBA codes showing the list of users who open the shared workbook:
ThisWorkbook:
Private Sub Workbook_Open()
Application.OnKey "{F2}", "UsersInfo"
UsersInfo
End Sub
Module1:
Public Sub UsersInfo()
Users = ActiveWorkbook.UserStatus
Dim sMsg As String
Dim nLen1 As Integer
Dim nLen2 As Integer
nLen1 = 0
nLen2 = 0
For Row = 1 To UBound(Users, 1)
If Len(Users(Row, 1)) > nLen1 Then
nLen1 = Len(Users(Row, 1))
End If
If Len(Users(Row, 2)) > nLen2 Then
nLen2 = Len(Users(Row, 2))
End If
Next
Dim sSpaces1 As String
Dim sSpaces2 As String
If Len("Users") < nLen1 Then
sSpaces1 = Space(nLen1 - Len("Users"))
Else
sSpaces1 = ""
End If
If Len("Opened at") < nLen2 Then
sSpaces2 = Space(nLen2 - Len("Opened at"))
Else
sSpaces2= ""
End If
sMsg = "Users" & sSpaces1 & Chr(9) & Chr(9) & "Opened at" & sSpaces2 & Chr(9) & Chr(9) & "Open Mode" & Chr(13) & Chr(10)
For Row = 1 To UBound(Users, 1)
If Len(Users(Row, 1)) < nLen1 Then
sSpaces1 = Space(nLen1 - Len(Users(Row, 1)))
Else
sSpaces1 = ""
End If
If Len(Users(Row, 2)) < nLen2 Then
sSpaces2 = Space(nLen2 - Len(Users(Row, 2)))
Else
sSpaces2 = ""
End If
sMsg = sMsg & Users(Row, 1) & sSpaces1 & Chr(9) & Chr(9)
sMsg = sMsg & Users(Row, 2) & sSpaces2 & Chr(9) & Chr(9)
Select Case Users(Row, 3)
Case 1
sMsg = sMsg & " Exclusive"
Case 2
sMsg = sMsg & " Shared"
End Select
sMsg = sMsg & Chr(13) & Chr(10)
Next
sMsg = sMsg & Chr(13) & Chr(10)
sMsg = sMsg & "Press F2 to show this information again!"
MsgBox sMsg, , "Current Users who open this workbook"
End Sub
ThisWorkbook:
Private Sub Workbook_Open()
Application.OnKey "{F2}", "UsersInfo"
UsersInfo
End Sub
Module1:
Public Sub UsersInfo()
Users = ActiveWorkbook.UserStatus
Dim sMsg As String
Dim nLen1 As Integer
Dim nLen2 As Integer
nLen1 = 0
nLen2 = 0
For Row = 1 To UBound(Users, 1)
If Len(Users(Row, 1)) > nLen1 Then
nLen1 = Len(Users(Row, 1))
End If
If Len(Users(Row, 2)) > nLen2 Then
nLen2 = Len(Users(Row, 2))
End If
Next
Dim sSpaces1 As String
Dim sSpaces2 As String
If Len("Users") < nLen1 Then
sSpaces1 = Space(nLen1 - Len("Users"))
Else
sSpaces1 = ""
End If
If Len("Opened at") < nLen2 Then
sSpaces2 = Space(nLen2 - Len("Opened at"))
Else
sSpaces2= ""
End If
sMsg = "Users" & sSpaces1 & Chr(9) & Chr(9) & "Opened at" & sSpaces2 & Chr(9) & Chr(9) & "Open Mode" & Chr(13) & Chr(10)
For Row = 1 To UBound(Users, 1)
If Len(Users(Row, 1)) < nLen1 Then
sSpaces1 = Space(nLen1 - Len(Users(Row, 1)))
Else
sSpaces1 = ""
End If
If Len(Users(Row, 2)) < nLen2 Then
sSpaces2 = Space(nLen2 - Len(Users(Row, 2)))
Else
sSpaces2 = ""
End If
sMsg = sMsg & Users(Row, 1) & sSpaces1 & Chr(9) & Chr(9)
sMsg = sMsg & Users(Row, 2) & sSpaces2 & Chr(9) & Chr(9)
Select Case Users(Row, 3)
Case 1
sMsg = sMsg & " Exclusive"
Case 2
sMsg = sMsg & " Shared"
End Select
sMsg = sMsg & Chr(13) & Chr(10)
Next
sMsg = sMsg & Chr(13) & Chr(10)
sMsg = sMsg & "Press F2 to show this information again!"
MsgBox sMsg, , "Current Users who open this workbook"
End Sub
Comments
Post a Comment