Complément de protection

tinet

XLDnaute Impliqué
bonjour à tous,

je dois enlever la protection, puis ajouter la protection à la suite de cette formule qui supprime la feuille de ma liste.
la protection et sur la feuille "liste"
Je n'arrive pas à modifier ma formule.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim Quit As String
If Not Intersect(Target, [c1]) Is Nothing Then
Quit = MsgBox("Etes-vous sûr(e) de vouloir Supprimer la fiche " & ActiveCell.Value _
, vbYesNo + vbInformation, "Suppression")
If Quit = vbYes Then
Set C = Sheets("Liste").Cells.Find(What:=ActiveCell)
If Not C Is Nothing Then
C.EntireRow.Delete Shift:=xlUp
Application.DisplayAlerts = False
On Error Resume Next: ActiveSheet.Delete
Application.DisplayAlerts = True
End If

Sheets("Liste").Activate
ActiveSheet.Unprotect Password:="AQW"
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False, Password:="AQW"
End If
End If
End Sub

Merci de votre aide

a+
 

Papou-net

XLDnaute Barbatruc
Re : Complément de protection

Bonjour tinet,

Je ne suis pas certain d'avoir compris l'intégralité de ton code, puisque je n'ai pas le fichier sous les yeux, mais au vu de sa lecture, je te suggère de le reprendre ainsi :

Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim Quit As String

If Not Intersect(Target, [c1]) Is Nothing Then
  Quit = MsgBox("Etes-vous sûr(e) de vouloir Supprimer la fiche " & ActiveCell.Value _
    , vbYesNo + vbInformation, "Suppression")
  If Quit = vbYes Then
    Set C = Sheets("Liste").Cells.Find(What:=ActiveCell)
    If Not C Is Nothing Then
      ActiveSheet.Unprotect "AQW"
      Application.DisplayAlerts = False
      C.EntireRow.Delete Shift:=xlUp
      ActiveSheet.Delete
      Application.DisplayAlerts = True
    End If
    Sheets("Liste").Activate
    ActiveSheet.Protect "AQW", DrawingObjects:=False, Contents:=True, Scenarios:=False
  End If
End If
End Sub

Étant paresseux de nature, et puisque l'informatique existe pour nous aider, j'ai simplifié les expressions usuelles et remis quelques lignes dans un ordre qui me paraît plus logique. Je te conseille également d'appliquer les retraits de paragraphe dans ton code : ça simplifie grandement la relecture et facilite la recherche des erreurs.

Espérant avoir répondu.

Cordialement.
 

Pierrot93

XLDnaute Barbatruc
Re : Complément de protection

Bonjour Tinet, Papou

3 petites choses au passage :
enlève peut être "On Error Resume Next", il est toujours préférable de gérer les errreur plutôt que de passer outre et continuer l'exécution du code...

l'utilisation de "quit" comme variable ne me parait pas souhaitable, sachant que c'est un mot réservé vba, méthode permettant de quitter l'appli Excel...

A priori tu supprimes la feuille active ("ActiveSheet.Delete"), or c'est dans celle-ci qu'est stocké ton code puisque procédure événementielle liée à cette dernière, pas sur que le code s'exécute jusqu'au bout....

bonne journée
@+
 

tinet

XLDnaute Impliqué
Re : Complément de protection

Bonjour Papou net, Pierrot93, et le forum.

Je mets en copie le fichier car le problème persiste.

a+
 

Pièces jointes

  • ficher adresse3.zip
    17.8 KB · Affichages: 21
  • ficher adresse3.zip
    17.8 KB · Affichages: 22
  • ficher adresse3.zip
    17.8 KB · Affichages: 23

Discussions similaires