Este fórum está sendo desativado

Depois de 9 anos, este fórum será desativado. Mas calma.... estamos migrando para uma comunidade no DISCORD. Junte-se a nós.

ENTRAR PARA DISCORD

Tópicos relacionados a códigos VBA, gravação de macros, etc.
  • Avatar do usuário
Por Guinardelli23
#70461
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

Avatar do usuário
Por Basole
Posts Avatar
#70497
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.
Por ueltonmorais
#71213
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

long long title how many chars? lets see 123 ok more? yes 60

We have created lots of YouTube videos just so you can achieve [...]

Another post test yes yes yes or no, maybe ni? :-/

The best flat phpBB theme around. Period. Fine craftmanship and [...]

Do you need a super MOD? Well here it is. chew on this

All you need is right here. Content tag, SEO, listing, Pizza and spaghetti [...]

Lasagna on me this time ok? I got plenty of cash

this should be fantastic. but what about links,images, bbcodes etc etc? [...]

Estamos migrando para uma comunidade no Discord