Guru do Excel e Power BI

Boa noite, tenho utilizado nas minhas planilhas um controle de acesso através da identificação do MAC ADERESS de cada máquina.

Porém cada vez que preciso adicionar uma nova máquina, tenho que atualizar o código e isso para várias planilhas.

Existe uma maneira de fazer com que cada planilha faça essa verificação em uma "planilha geral" onde ficará listado cada endereço MAC? Isso a fim de que eu possa atualizar apenas a planilha geral para novos computadores.

Caso exista também outra forma melhor. Desde já agradeço

Guinardelli23 escreveu:Existe uma maneira de fazer com que cada planilha faça essa verificação em uma "planilha geral" onde ficará listado cada endereço MAC? Isso a fim de que eu possa atualizar apenas a planilha geral para novos computadores.

@Guinardelli23

Sim, pode usar o AdoDB por exemplo, para fazer uma consulta na Pasta_de_trabalho em questão, e retornar True caso exista o endereço MAC contido na lista.

Sua função é a mais completa que vi, e se possivel gostaria de saber como faço para usar ela em minhas planilhas, eu uso uma que verifica o usuário do computador, mas funciona apenas em 1 computador, e eu preciso usar na rede do trabalho e são 3 computadores. Desde já agradeço.

Guinardelli23 escreveu: ↑26 Abr 2022 às 20:47 Boa noite, tenho utilizado nas minhas planilhas um controle de acesso através da identificação do MAC ADERESS de cada máquina.

Porém cada vez que preciso adicionar uma nova máquina, tenho que atualizar o código e isso para várias planilhas.

Existe uma maneira de fazer com que cada planilha faça essa verificação em uma "planilha geral" onde ficará listado cada endereço MAC? Isso a fim de que eu possa atualizar apenas a planilha geral para novos computadores.

Caso exista também outra forma melhor. Desde já agradeço

Código: Selecionar todos

Dim sComputer As String
Dim MeuMAC As String
Dim oWMIService As Object
Dim oAdapters As Object
Dim oAdapter As Object
Dim sRet As String

    sComputer = "."
    sRet = ""
Set oWMIService = GetObject("winmgmts:" & "!\\" & sComputer & "\root\cimv2")
Set oAdapters = oWMIService.ExecQuery("Select * from Win32_NetworkAdapterConfiguration Where IPEnabled = True")
For Each oAdapter In oAdapters
    If Len(sRet) > 0 Then
            sRet = sRet + "/" + oAdapter.MACAddress
Else
            sRet = oAdapter.MACAddress
End If
Next oAdapter
    GetMACAddr = sRet
    
    
'-----CADASTRO DOS USUÁRIOS---------------------------------------------------------------------------------------------------------
        
    MeuMAC1 = "D8:BB:C1:00:EC:F3"      
    MeuMAC2 = "70:85:C2:31:25:F4"     
    MeuMAC3 = "3C:7C:3F:3B:46:96"     
    MeuMAC4 = "74:D4:35:9A:BD:60"      
    MeuMAC5 = "20:47:47:FF:775:B2"    
    MeuMAC6 = "94:DE:80:F6:65:B4"      
    MeuMAC7 = "10:98:36:FC:78:56"      
    MeuMAC8 = "20:47:47:33:63:39"      
    MeuMAC9 = "30:9C:23:AB:56:90"     
    MeuMAC10 = "70:85:22:CA:25:4E"    
    MeuMAC11 = "8C:A9:82:FD:55:61"      
    MeuMAC12 = "B0:88:AA:27:AF:64"     
    MeuMAC13 = "5C:C9:D3:97:05:EA"      
    MeuMAC14 = "FC:452:96:F6:9C:A9"     
    MeuMAC15 = "D8:BB:C2:04:EC:8F"     
    MeuMAC16 = "18:C0:4D:55:27:FC"     
    MeuMAC17 = "A3:A1:59:6C:54:85"      

'-----VALIDAÇÃO---------------------------------------------------------------------------------------------------------

 If MeuMAC1 = GetMACAddr Then
                                    
Else
    If MeuMAC2 = GetMACAddr Then

Else
    If MeuMAC3 = GetMACAddr Then

Else
    If MeuMAC4 = GetMACAddr Then

Else
    If MeuMAC5 = GetMACAddr Then

Else
    If MeuMAC6 = GetMACAddr Then

Else
    If MeuMAC7 = GetMACAddr Then

Else
    If MeuMAC8 = GetMACAddr Then

Else
    If MeuMAC9 = GetMACAddr Then

Else
    If MeuMAC10 = GetMACAddr Then
                                   
Else
    If MeuMAC11 = GetMACAddr Then
    
Else
    If MeuMAC12 = GetMACAddr Then
    
Else
    If MeuMAC13 = GetMACAddr Then
    
Else
    If MeuMAC14 = GetMACAddr Then
    
Else
    If MeuMAC15 = GetMACAddr Then
        
Else
    If MeuMAC16 = GetMACAddr Then
        
Else
    If MeuMAC17 = GetMACAddr Then

'-----O QUE ACONTECE SE NÃO VERIFICA--------------------------------------------------------------------------------------------------------
        
Application.ScreenUpdating = False
Else
With ActiveWindow
End With
       Application.DisplayAlerts = False
       ActiveWorkbook.Close
           
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
         
'-----004-O QUE ACONTECE SE VERIFICA---------------------------------------------------------------------------------------------------------

'pausa atualizações tela
    Application.ScreenUpdating = False
 
    
'desprotege planilha
    ThisWorkbook.Unprotect
'atualiza permissões
    Sheets("Início").Visible = True
    Sheets("Consoles").Visible = True
    Sheets("misula").Visible = True
    Sheets("Neoprene").Visible = True
 'seleciona início
    Sheets("Início").Select

    Application.ScreenUpdating = True
    
End Sub