Ne pas proposer d'enregistrer avant de quitter le classeur

Bonjour tous,

J'ai un code qui permet de donner l'autorisation d'ouverture d'un classeur en fonction de l'usurname et du numéro de série du disque dur d'un ordinateur.

Si il ne reconnait pas l'ordinateur il quitte l'application après avoir afficher le message "vous n'êtes pas autorisé à utiliser ce fichier.

Il fonctionnait très bien jusqu'à ce que j'ajoute une partie qui permet de l'adapter également sur Excel 64bits.

Maintenant, il délivre toujours le message, mais avant de quitter il propose d'enregistrer ou pas avant de quitter.

Comment peut-on éviter cette étape ?

J'ai pourtant posé la ligne de code

Application.DisplayAlerts = False

avant de quitter.

Merci de votre aide.

Option Explicit

#If VBA7 Then
Private Declare PtrSafe Function GetVolumeInformation Lib _
"Kernel32.dll" Alias "GetVolumeInformationA" (ByVal _
lpRootPathName As String, ByVal lpVolumeNameBuffer As _
String, ByVal nVolumeNameSize As Integer, _
lpVolumeSerialNumber As LongPtr, _
lpMaximumComponentLength _
As LongPtr, lpFileSystemFlags As LongPtr, ByVal _
lpFileSystemNameBuffer As String, ByVal _
nFileSystemNameSize As LongPtr) As LongPtr

#Else
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
#End If

Function NumSerieDD(LettreDD As String) As LongPtr
Dim SerialNum As LongPtr
Dim R As LongPtr
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 Verification_pc()
'Partie ? coller dans thisworbook ou module 1 si autodestruction

If Environ("Username") = "XXXXX" And NumSerieDD("C") = "XXXXXX" 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.DisplayAlerts = False
Application.Quit

Exit Sub
End If
End Sub

Bonjour

Essaie cette instruction :

ActiveWorkbook.Close False

Bye !

Bonjour à tous,

ThisWorkbook.Saved = True

eric

Merci pour vos réponses.

Une nouvelle fois un soucis résolu dans un temps record.

Bonne journée et à bientôt.

Rechercher des sujets similaires à "pas proposer enregistrer quitter classeur"