• 0
Sign in to follow this  
BruninhuBru

identificação do usuário para abertura da planilha

Question

Olá pessoal! Sou novo no forúm, preciso da ajuda de vocês. Por favor, me auxiliem, preciso disso urgente.

Estou fazendo um modelo de planilha que terá como nome a matrícula funcional do colaborador, porém, ela só pode ser aberta se a matrícula funcional do usuário que estiver logado na máquina for igual ao nome da planilha.

Ex: usuário 123 só conseguirá abrir a planilha de nome "123"

Se puderem me ajuder, ficarei muito grato.

Grande abraço e parabéns pelo site, ele é fantástico.

Abs

[email protected]

Share this post


Link to post
Share on other sites

7 answers to this question

Recommended Posts

  • 0

O código abaixo funcionará apenas se as macros estiverem ativados. Deve ser colado na classe EstaPasta_de_trabalho.

Crie uma Planilha na Pasta de Trabalho chamada Início, que será a Planilha que usuários não autorizados a acessar outras Planilhas serão redirecionados.

Public sUsuário As String
Public sComputador As String

#If VBA7 And Win64 Then
    Private Declare PtrSafe Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" ( _
      ByVal lpBuffer As String, nSize As Long) As Long
    Private Declare PtrSafe Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" ( _
      ByVal lpBuffer As String, nSize As Long) As Long
#Else
    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
#End If

Private Sub Workbook_Open()
    Dim l As Long
    Dim s As String
    
    'Obtém Nome do Usuário
    l = 255
    s = String(l, vbNullChar)
    l = GetUserName(s, l)
    sUsuário = PorçãoNãoNula(s)

    '*** OPCIONAL ***
    'Obtém Nome do Computador
    l = 255
    s = String(l, vbNullChar)
    l = GetComputerName(s, l)
    sComputador = PorçãoNãoNula(s)

    MsgBox "O usuário atual é " & sUsuário, vbInformation
    MsgBox "O computador atual é " & sComputador, vbInformation
End Sub

Private Function PorçãoNãoNula(s As String) As String
'Mostra a porção de uma string à esquerda de
'caracteres nulos (vbNullString e Chr(0).

    Dim n As Long

    n = InStr(1, s, vbNullChar)
    If n = 0 Then
        PorçãoNãoNula = s
    Else
        PorçãoNãoNula = Left(s, n - 1)
    End If
End Function

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    If Sh.Name <> "Início" Then
        If Sh.Name <> sUsuário Then
            MsgBox "Prezado(a) '" & sUsuário & "'," & vbNewLine & _
              "Você não tem autorização para acessar esta Planilha." _
              , vbCritical
            Sheets("Início").Select
            Sheets("Início").Activate
        End If
    End If
End Sub

Share this post


Link to post
Share on other sites
  • 0
Aquele código estará na planilha de nome 123
O código deve ficar na classe da Pasta de Trabalho, e não na classe de uma Planilha
quando um usuário de matrícula funcional 123 tentar abri-la ele irá conseguir visualizar e trabalhar com ela normalmente, agora, caso seja um usuário de marícula funcional número 124 nã terá acesso a esta planilha, mas apenas a planilha de nome igual a sua matrícula funcional, certo?

Certo.

Edited by benzadeus

Share this post


Link to post
Share on other sites
  • 0

Obrigado pela resposta ao meu tópico!

Sou novo em programção e queria tirar um dúvida sobre o código que você me passou, me desculpe pela incoveniência.

Esse código estará na planilha de nome 123, quando um usuário de matrícula funcional 123 tentar abri-la ele irá conseguir visualizar e trabalhar com ela normalmente, agora, caso seja um usuário de marícula funcional número 124 nã terá acesso a esta planilha, mas apenas a planilha de nome igual a sua matrícula funcional, certo?

Share this post


Link to post
Share on other sites
  • 0

Pessoal,

A parte em negrito do código abaixo está vermelha no meu computador e a macro não está rodando em meu computador. Estou usando o Pacote Office 2003 em um Win XP. Alguém sabe o que há de errado?

Obrigado!

#If VBA7 And Win64 Then

Private Declare PtrSafe Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" ( _

ByVal lpBuffer As String, nSize As Long) As Long

Private Declare PtrSafe Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" ( _

ByVal lpBuffer As String, nSize As Long) As Long

#Else

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

#End If

Share this post


Link to post
Share on other sites
  • 0

Isso é bastante esquisito.

No entanto, substitua todo esse código:

#If VBA7 And Win64 Then
Private Declare PtrSafe Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" ( _
ByVal lpBuffer As String, nSize As Long) As Long
Private Declare PtrSafe Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" ( _
ByVal lpBuffer As String, nSize As Long) As Long
#Else
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
#End If
por:
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

Share this post


Link to post
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Answer this question...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Sign in to follow this