- 26 Abr 2022 às 20:47
#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
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