Autoriser l'ouverture que sur un PC spécifique

Private Declare Function GetVolumeInformation Lib _
"Kernel32.dll" Alias "GetVolumeInformationA" (ByVal _
lpRootPathName As String, ByVal lpVolumeNameBuffer As _
String, ByVal nVolumeNameSize As Integer, _
lpVolumeSerialNumber As Long, _
lpMaximumComponentLength _
As Long, lpFileSystemFlags As Long, ByVal _
lpFileSystemNameBuffer As String, ByVal _
nFileSystemNameSize As Long) As Long

Function NumSerieDD(LettreDD As String) As Long
Dim SerialNum As Long
Dim R As Long
Dim Temp1 As String
Dim Temp2 As String
LettreDD = LettreDD & ":\"
Temp1 = String$(255, Chr$(0))
Temp2 = String$(255, Chr$(0))
R = GetVolumeInformation(LettreDD, Temp1, _
Len(Temp1), SerialNum, 0, 0, Temp2, Len(Temp2))
NumSerieDD = SerialNum
End Function

Sub Test_NumDD()
MsgBox NumSerieDD("C")
End Sub

Option Explicit

Private Declare Function GetVolumeInformation Lib _
"Kernel32.dll" Alias "GetVolumeInformationA" (ByVal _
lpRootPathName As String, ByVal lpVolumeNameBuffer As _
String, ByVal nVolumeNameSize As Integer, _
lpVolumeSerialNumber As Long, _
lpMaximumComponentLength _
As Long, lpFileSystemFlags As Long, ByVal _
lpFileSystemNameBuffer As String, ByVal _
nFileSystemNameSize As Long) As Long

Function NumSerieDD(LettreDD As String) As Long
Dim SerialNum As Long
Dim R As Long
Dim Temp1 As String
Dim Temp2 As String
LettreDD = LettreDD & ":\"
Temp1 = String$(255, Chr$(0))
Temp2 = String$(255, Chr$(0))
R = GetVolumeInformation(LettreDD, Temp1, _
Len(Temp1), SerialNum, 0, 0, Temp2, Len(Temp2))
NumSerieDD = SerialNum
End Function

Sub Test_NumDD()
If Environ("Username") = "jAutre" And NumSerieDD("C") = "-1610042500" Then ' Adapter les Infos en testant avec Test_Info
MsgBox "Vous êtes autorisé à accéder à ce fichier", , "Sécurité"
Else:  MsgBox "Vous n'avez pas l'autorisation d'accéder à ce fichier", , "Sécurité"
Exit Sub
End If
End Sub

Sub Test_Info()
Range("A1") = Environ("Username")
Range("A2") = NumSerieDD("C")
End Sub

Option Explicit

Private Declare Function GetVolumeInformation Lib _
"Kernel32.dll" Alias "GetVolumeInformationA" (ByVal _
lpRootPathName As String, ByVal lpVolumeNameBuffer As _
String, ByVal nVolumeNameSize As Integer, _
lpVolumeSerialNumber As Long, _
lpMaximumComponentLength _
As Long, lpFileSystemFlags As Long, ByVal _
lpFileSystemNameBuffer As String, ByVal _
nFileSystemNameSize As Long) As Long

Function NumSerieDD(LettreDD As String) As Long
Dim SerialNum As Long
Dim R As Long
Dim Temp1 As String
Dim Temp2 As String
LettreDD = LettreDD & ":\"
Temp1 = String$(255, Chr$(0))
Temp2 = String$(255, Chr$(0))
R = GetVolumeInformation(LettreDD, Temp1, _
Len(Temp1), SerialNum, 0, 0, Temp2, Len(Temp2))
NumSerieDD = SerialNum
End Function
Private Sub Workbook_Open()
    
If NumSerieDD("C") = "-n° de série" Then ' Adapter les Infos en testant avec Test_Info
MsgBox "Vous êtes autorisé à accéder à ce fichier", , "Sécurité"
Else:  MsgBox "Vous n'avez pas l'autorisation d'accéder à ce fichier", , "Sécurité"
Application.Quit

Exit Sub
End If
End Sub

Sub Test_NumDD()
If Environ("Username") = "Autre" And NumSerieDD("C") = "-1610042500" Then ' Adapter les Infos en testant avec Test_Info
MsgBox "Vous êtes autorisé à accéder à ce fichier", , "Sécurité"
Else:  MsgBox "Vous n'avez pas l'autorisation d'accéder à ce fichier", , "Sécurité"
ActiveWorkbook.Saved = True
ActiveWorkbook.Close
End If
End Sub