Tout effacer si déprotection projet VBA

[GUY rrr]

Bonjour le forum,

Je souhaite savoir si il est possible de faire une macro qui vérifie que le projet VBA soit bien protégé et si non, qui efface toute les données du fichier en prenant soin d'enregistrer dans la foulée.

Merci aux personnes qui voudront bien se pencher sur ma demande.

 

[Patrice33740]

Je ne vois pas à quoi ça pourrait servir :
- Il est toujours possible d'empêcher l'exécution des macros (et heureusement !!!)
- lorsqu'un projet n'est pas protégé on peut supprimer la macro qui efface les données !

Il faut arrêter de croire qu'avec Excel ou VBA on peut protéger des informations ou du code !

 

[GUY rrr]

Bonsoir Patrice33740, le forum,

J'apprécie votre point de vue (ainsi que celui de beaucoup d'autres dans ce domaine) et le partage ... Cependant ma question était de savoir si il est possible de faire une macro qui vérifie que le projet VBA soit bien protégé et si non, qui efface toute les données du fichier en prenant soin d'enregistrer dans la foulée, et non pas de savoir dans quelle mesure l'efficacité de la protection était fiable ... ou pas.

Merci aux personnes qui voudront bien se pencher sur ma demande.

 

[Patrice33740]

ma question était de savoir si il est possible de faire une macro qui vérifie que le projet VBA soit bien protégé et si non, qui efface toute les données du fichier en prenant soin d'enregistrer dans la foulée,

La réponse est oui c'est possible de faire une macro qui réalise cela.

Vérifier la protection du projet : Propriétés (Modèle Complément Visual Basic) | Microsoft Docs
Effacer les données : Méthode Range.Clear (Excel) | Microsoft Docs
Enregistrer : Workbook.Save, méthode (Excel) | Microsoft Docs

 

[GUY rrr]

Bonsoir Patrice33740, le forum,

Merci pour votre retour et ces quelques liens avec lesquels je vais tenter de mettre en place quelque chose ressemblant à une macro ...

Bonne soirée

 

[GUY rrr]

Bonsoir Patrice33740, le forum,

Après quelques recherches, j'ai pu trouver des éléments pouvant effectuer mes 2 dernières demandes , à savoir:

Dim Feuille As Worksheet
    For Each Feuille In ThisWorkbook.Worksheets
        If Feuille.Name <> ActiveSheet.Name Then Feuille.Delete
    Next Feuille
    
    ActiveSheet.Cells.Delete Shift:=xlUp
    ThisWorkbook.Save
End If
End Sub

En revanche, pour ma première demande, je ne sais pas comment m'y prendre, ni où placer tout ceci ...
Auriez-vous une ou plusieurs suggestions et/ou solutions à me proposer afin d'avoir une macro complète et efficace ?

Merci pour votre retour

 

[GUY rrr]

Bonjour Patrice33740, le forum,

Après plusieurs essais infructueux, je me permets de vous demander de l'aide.

Mon dernier essai dans ThisWorkbook est le suivant:

Private Sub Workbook_Open()
Set MyApp.VBE.ActiveCodePane = MyApp.VBE.CodePanes
Dim Feuille As Worksheet
    For Each Feuille In ThisWorkbook.Worksheets
        If Feuille.Name <> ActiveSheet.Name Then Feuille.Delete
    Next Feuille
    ActiveSheet.Cells.Delete Shift:=xlUp
    ThisWorkbook.Save
Else
End If
End Sub

Mais à l'ouverture du fichier j'ai le message ci-joint:

N'ayant que très peu de connaissances (limite nulles ) dans ce domaine, je sollicite à nouveau vos compétences.

Merci pour votre retour

 

[dysorthographie]

bonjour,
ton code est aberrant comment peut il fonctionner!

fais plusieurs [F8] avant de le tester à l'ouverture du classeur!

 

[GUY rrr]

Bonjour dysorthographie, Patrice33740, le forum,

ton code est aberrant comment peut il fonctionner!

Je confirme, ça ne fonctionne pas

fais plusieurs [F8] avant de le tester à l'ouverture du classeur!

J'ai fait mais toujours la même chose

Je vous joins un classeur test car je ne vois pas ce que vous voulez m'expliquer ...

Je tiens à rappeler que ma compréhension des codes est plus que limitée. Merci de bien vouloir faire preuve d'indulgence.

Merci pour votre retour

Edit: je viens d'ajouter le classeur oublié

 

[dysorthographie]

dans les option d'Excel => centre de gestion de la confidentialité!

notes que cette option dois être activé sur la machine qui exécute la macro autan dire que ça n'a pas beaucoup de chance d’aboutir!

If ThisWorkbook.VBProject.Protection = vbext_pp_none Then
MsgBox "Le projet indiqué n'est pas verrouillé."
End If

 

[GUY rrr]

dysorthographie,

Je ne comprends pas ce que vous me dites ...
Vous mettez un bout de code ( que je ne sais où insérer ) et m'expliquez que mes macros sont désactivées par défaut mais qu'une notification doit apparaitre ... pour activer ces mêmes macros ...

A l'ouverture du classeur, je n'ai que le message du post 7.
Je joins mon classeur test (mdp; GUY)

Merci pour votre retour

 

[dysorthographie]

le code que je fournis permet de vérifier si le projet est verrouillé par un mot de passe!

Private Sub Workbook_Open()

If ThisWorkbook.VBProject.Protection = vbext_pp_none Then
MsgBox "Le projet indiqué n'est pas verrouillé."
End If

End Sub

mais pour cela il faut cocher ,dans les options d'Excel,la case Accès approuvé au modèle d'objet du projet VBA comme le montre l'image de mon précédent poste!

 

[GUY rrr]

dysorthographie,

Je pense avancer petit à petit grâce à votre aide .

A force de tests, j'ai plus ou moins réussi à adapter et à faire quelque chose, mais ...

La macro ne se comporte pas comme je le souhaite, à savoir:

Actuellement, les feuilles s'effacent UNIQUEMENT SI le projet VBA est déprotégé à l'ouverture.

Mon but est d’effacer les feuilles SI le projet VBA est déprotégé à l'ouverture ET/OU SI le projet VBA est déprotégé après ouverture.

Ceci peut être effectué ?

Je joins mon classeur avec modifications

Merci pour votre soutien

 

[dysorthographie]

Private Sub Workbook_Activate()
KillBill
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
KillBill
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
KillBill
End Sub

Private Sub Workbook_Deactivate()
KillBill
End Sub

Private Sub Workbook_NewSheet(ByVal Sh As Object)
KillBill
End Sub

Private Sub Workbook_Open()
KillBill
End Sub



Private Sub Workbook_SheetActivate(ByVal Sh As Object)
KillBill
End Sub

Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
KillBill
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
KillBill
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
KillBill
End Sub

Private Sub KillBill()
Application.EnableEvents = False
If ThisWorkbook.VBProject.Protection = vbext_pp_none Then
'MsgBox "Le projet indiqué n'est pas verrouillé."
Application.DisplayAlerts = False 'on empêche les pop-ups pour confirmer la suppression des Feuilles d'apparaître
    
    'on supprime toutes les Feuilles sauf la feuille active (car le classeur doit toujours contenir au moins une Feuille)
    Dim Feuille As Worksheet
    For Each Feuille In ThisWorkbook.Worksheets
        If Feuille.Name <> ActiveSheet.Name Then Feuille.Delete
    Next Feuille
    
    'on supprime le contenu de la Feuille restante
    ActiveSheet.Cells.Delete Shift:=xlUp
    'on sauvegarde le fichier pour rendre la suppression du contenu permanente
    ThisWorkbook.Save
    
    Application.DisplayAlerts = True 'on réenclanche l'affichage des pop-ups de confirmation/alerte
End If
Application.ScreenUpdating = True 'on réenclanche l'affichage des changements
Application.EnableEvents = True
End Sub

 

[GUY rrr]

Bonsoir dysorthographie, Patrice33740, le forum,

dysorthographie, MERCI pour votre proposition qui me convient parfaitement .

Une bonne soirée à toutes et tous.