Erreur d’exécution '70': Permission refusée
Bonjour chers amis
je développe une application et je n'aimerais pas que les utilisateurs puissent renommer le fichier à volonté. Pour cela lorsque le nom du fichier est modifié, une fois le fichier relancé,l'application crée une copie du fichier et remet le nom initial. Ensuite l'application supprime le fichier dont le nom est modifié en utilisant la fonction 'Kill'. Cependant au cours de la fermeture du fichier, l'application affiche: Erreur d’exécution '70': Permission refusée. Veuillez m'aider à résoudre ce problème. J'ai joint le fichier de l'application.Merci.
bonjour,
une proposition :
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim File_name As String
Dim Path_name As String
Dim Current_File_name As String
Dim Complete_File_name As String
Dim Old_File_name As String
File_name = ActiveWorkbook.Name
Path_name = ThisWorkbook.Path
Current_File_name = "Test.xlsm"
Complete_File_name = Path_name & "\" & Current_File_name
Old_File_name = Path_name & "\" & File_name
If UCase(File_name) <> UCase(Current_File_name) Then
Application.DisplayAlerts = False
ThisWorkbook.SaveAs Complete_File_name
Application.DisplayAlerts = True
Kill Old_File_name
End If
Application.ScreenUpdating = False
Application.EnableEvents = False
If ThisWorkbook.Saved = True Then wbSaved = True
Call Hide_Sheets
If wbSaved = True Then
ThisWorkbook.Save
End If
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If SaveAsUI = True And UCase(ThisWorkbook.Name) = "TEST.XLSM" Then MsgBox " vous n'êtes pas autorisé à prendre une copie de ce fichier": Cancel = True
End Sub
Merci beaucoup. Ton code résout mon problème. Il n' y a plus d'erreur d’exécution 70. L'application n'affiche plus: permission refusée. Seulement le MsgBox que tu as mis dans le Workbook_BeforeSave ne fonctionne pas. J'ai introduit le MsgBox dans le Workbook_BeforeClose et ça fonctionne parfaitement.
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim File_name As String
Dim Path_name As String
Dim Current_File_name As String
Dim Complete_File_name As String
Dim Old_File_name As String
File_name = ActiveWorkbook.Name
Path_name = ThisWorkbook.Path
Current_File_name = "Test.xlsm"
Complete_File_name = Path_name & "\" & Current_File_name
Old_File_name = Path_name & "\" & File_name
If UCase(File_name) <> UCase(Current_File_name) Then
Application.DisplayAlerts = False
ThisWorkbook.SaveAs Complete_File_name
Application.DisplayAlerts = True
Kill Old_File_name
End If
Application.ScreenUpdating = False
Application.EnableEvents = False
If ThisWorkbook.Saved = True Then wbSaved = True
Call Hide_Sheets
If wbSaved = True Then
ThisWorkbook.Save
End If
Application.ScreenUpdating = True
Application.EnableEvents = True
MsgBox " Vous n'êtes pas autorisé à renommer ce fichier"
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Cancel = True
End Sub
bonsoir,
Seulement le MsgBox que tu as mis dans le Workbook_BeforeSave ne fonctionne pas
c'est que probablement je n'ai pas tout compris ce que tu voulais faire. Cela fonctionne dans le scénario que j'ai imaginé.
soit la personne fait une copie du fichier en dehors d'excel et ouvre le fichier puis veut le sauvegarder, soit la personne essaie de faire une sauvegarde du fichier original sous un autre nom.
dans le premier cas, pas de message mais le fichier est renommé et la version copiée est détruite, dans le second cas, la copie n'est pas autorisée.
j'ai du mal à imaginer un autre scénario, mais si ta correction te convient, zadig !