Suppression de macro bloquer par mdp macro

Le 02/09/2020 à 16:23

Bonjour à tous.

Tout d'abord je voudrais remercier les membres de ce forum m'ayant permis de m'auto-former au VBA.

Pour en venir à mon problème, j'ai réussi à créer plusieurs macro dans un fichier et l'une d'entre elle consiste à effectuer un archivage automatique mensuel du fichier.

L'archivage se passait bien jusqu'à l'intégration d'un mot de passe pour protéger la macro. Du coup la marco de suppression ne supprime plus.

Voici l'enchainement de macro posant problèmes:

Vérification des conditions d'archivage

Private Sub Workbook_BeforeClose(Cancel As Boolean)
moisannee = Format(Date, "yyyy-mm-dd")

Sheets("légende").Activate

If DateDiff("m", Range("B" & 11).Value, Now, vbMonday, vbFirstJan1) >= 1 Then
    If MsgBox("L'archivage du fichier va être réalisée. Les informations que vous avez modifier peuvent-elles être enregistrer?" & vbCrLf & "(Si oui merci de ne pas interrompre les 3 enregistrements qui vont suivre)", vbYesNo) = vbNo Then
    Exit Sub
    Else
        Range("B" & 11) = moisannee
            ActiveWorkbook.Save
            ActiveWorkbook.SaveAs Filename:= _
            "DESTINATION DE LA SAUVEGARDE " & moisannee & ".xlsm", _
            FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
            Supprimer_Macro_Precise
    End If
End If
End Sub

Suppression de la macro précédente (c'est ici que le mot de passe bloque)

Sub Supprimer_Macro_Precise()

Dim Debut As Integer, Lignes As Integer
Dim NomMod As String, NomMacro As String

NomMod = "ThisWorkbook"
NomMacro = "Workbook_BeforeClose"

With ThisWorkbook.VBProject.VBComponents(NomMod).CodeModule
    Debut = .ProcStartLine(NomMacro, 0)
    Lignes = .ProcCountLines(NomMacro, 0)
    .DeleteLines Debut, Lignes
    ActiveWorkbook.Save
End With
End Sub

Pourriez-vous m'aider s'il vous plait?

il faudrait également que le mots de passe soit remis à la fin de l'archivage.

Merci beaucoup

Le 02/09/2020 à 18:36

Bonsoir,

Est-ce que le fichier archivé doit garder ses macros fonctionnelles s'il y en a d'autre ? Ou est un fichier destiné à la consultation pur, donc plus de modification à faire ?
Dans ce cas là vous pourriez enregistrer une sauvegarde mais en format xlsX et du coup il n'y a plus de macro !

@ bientôt

LouReeD

Le 04/09/2020 à 09:36

Bonjour,

Dans l'idéal il faudrait que les macros restent fonctionnelles dans le fichier d'archive si une solution est trouvée.

En attendant je vais utiliser ta solution et enregistrer le fichier en xlsx.

Merci

Le 04/09/2020 à 10:00

Bonjour,

Peut-être une solution ici : https://forum.excel-pratique.com/viewtopic.php?t=120809

Le 04/09/2020 à 12:31

Merci Pijaku,

J'ai essayer ta méthode et j'ai une erreur 438 qui apparait. J'ai bien essayé en supprimant le fichier comme indiquer ici.

Mais j'ai toujours l'erreur

La macro est installé sur excel 2013 si ça peut jouer.

Merci pour le coup de main.

Le 04/09/2020 à 12:48

Le fait de faire SaveAs, le fichier d'archive est créé, mais il n'est pas le classeur actif, du coup vous essayez de supprimer un code en cours d'exécution sur le classeur actif. C'est peut être là le problème, il faut dans la procédure cibler le classeur archive et non pas l'actif...

@ bientôt

LouReeD

Le 05/09/2020 à 08:39

BOnjour

j'avais fais une fonction il y a quelques années... pour déverrouillé le VBA project par code.. pour corriger des lignes de codes dans un fichier diffuser à grande echelle....

le voici

Sub UnprotectVBProject(WB As Workbook, ByVal Password As String)
Dim vbProj As Object
Set vbProj = WB.VBProject
If vbProj.Protection <> 1 Then Exit Sub
Set Application.VBE.ActiveVBProject = vbProj
SendKeys Password & "~~~"
Application.VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True).Execute
End Sub

avec un appel du type :

'ouverture du fichier à traiter
Workbooks.Open nomfichier
Application.EnableEvents = True
'deproctection du VBA project
UnprotectVBProject ActiveWorkbook, "mot_de_passe"
DoEvents

Fred

Le 05/09/2020 à 08:45

j'avais aussi activer cette référence... mais je ne sais pas si c'était pour cette partie du code...

excelpratique

Fred

Le 09/09/2020 à 12:10

Bonjour à vous et désolé pour mon absence j'étais en déplacement pro

@ LouReeD : La macro fonctionnait très bien avant d'y intégrer un mot de passe, du coup je ne pense pas que le problème vienne de la. Sinon je serais encore plus perdu et demanderais surement encore plus de conseil.

@ fred2406 : J'ai essayer d'intégrer ta macro à la mienne mais j'ai encore quelque souci (ps : Je n'ai pas Microsoft Forms2.0 dans mes références).

Private Sub Workbook_BeforeClose(Cancel As Boolean)
moisannee = Format(Date, "yyyy-mm-dd")

Sheets("légende").Activate

If DateDiff("m", Range("B" & 11).Value, Now, vbMonday, vbFirstJan1) >= 1 Then
    If MsgBox("L'archivage du fichier va être réalisée. Les informations que vous avez modifier peuvent-elles être enregistrer?" & vbCrLf & "(Si oui merci de ne pas intérrompre les 3 enregistrements qui vont suivre)", vbYesNo) = vbNo Then
    Exit Sub
    Else
        Range("B" & 11) = moisannee
            ActiveWorkbook.Save
            ActiveWorkbook.SaveAs Filename:= _
            "C:\Users\JC5860BN\Desktop\a suppr\save auto\Suivi modifications départs " & moisannee & ".xlsm", _
            FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
            UnprotectVBProject ActiveWorkbook, ""
            Supprimer_Macro_Precise
    End If
End If
End Sub
Sub UnprotectVBProject(WB As Workbook, ByVal Password As String)
Dim vbProj As Object
Set vbProj = WB.VBProject
If vbProj.Protection <> 1 Then Exit Sub
Set Application.VBE.ActiveVBProject = vbProj
SendKeys Password & "mdp"
Application.VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True).Execute
End Sub
Sub Supprimer_Macro_Precise()

Dim Debut As Integer, Lignes As Integer
Dim NomMod As String, NomMacro As String

NomMod = "ThisWorkbook"
NomMacro = "Workbook_BeforeClose"

With ThisWorkbook.VBProject.VBComponents(NomMod).CodeModule
    Debut = .ProcStartLine(NomMacro, 0)
    Lignes = .ProcCountLines(NomMacro, 0)
    .DeleteLines Debut, Lignes
    ActiveWorkbook.Save
End With
End Sub

Par contre j'ai encore quelques problèmes:

J'ai bien le mot de passe qui se remplie correctement par contre je doit cliquer sur "OK" manuellement et dans le même temps un message d'erreur m'indiquant que la macro ne se poursuit pas car les macros sont protéger.Et quand je clique sur "OK" ça m'enlève la protection et affiche les propriétés de VBAproject.

Mais du coup le message d'erreur précédent arrête la macro et ne la relance pas et mon archivage ne se finit pas convenablement.

Je vous mets le fichier excel épuré en pièce jointe si je n'ai pas été assez clair.

12demande-d-aide.zip (156.06 Ko)

Encore merci pour votre aide

edit : Je suis sur excel 2013 pour info

Le 09/09/2020 à 14:18

Bien reçu... Tant pis pour moi...

@ bientôt

LouReeD

Le 11/09/2020 à 11:31

Bonjour...

je suis un peu débordé professionnellement parlant... mais fournit un fichier de test avec ce que tu souhaites supprimer je regarderais ce que je peux faire...

Fred

Le 16/09/2020 à 11:20

Bonjour Fred

Merci de te pencher sur mon problème

Le fichier est disponible dans mon post précédents. (2 post au dessus du tiens)

Le 21/09/2020 à 17:27

Salut l'équipe

Je remonte le sujet pour savoir si une âme charitable peut m'aider à trouver la solution

Merci beaucoup

Le 22/09/2020 à 09:43

Bonjour

pas eut le temps de regarder... j'essai de regarde cela d'ici la fin de semaine si personne d'autre n'intervient

fred

Le 25/09/2020 à 12:01

Bonjour

Je suis partie du fichier que j'avais fait il y a quelques années.. c'est pas tout a fait la demande initiale mais celle ci fonctionne je te laisserais adapter en conséquence.

8supprime-macrov2.xlsm (23.09 Ko)

Dans le principe, on appuie sur le bouton bleu du fichier joint

on renseigne le fichier a traiter... donc dans ton exemple du forum "demande-d-aide.xlsm"

le code va déverrouiller le VBA project, et supprimer toutes les lignes présentes dans le Thisworkbook du fichier ouvert.

Volontairement je ne fait pas d'enregistrement... et cela pour éviter de faire des erreurs, je te laisse le soin de prendre cette responsabilité.

et corollaire de cela j'ai aussi volontairement pas fait la fermeture du fichier précédemment ouvert, pour que tu puisse voir le résultat de l’exécution du code.

Ceci ne marche pas si tu exécute le code en mode pas à pas... il faut le faire exécuter en une seule fois (surtout le début concernant le déverrouillage du vbproject)

Je n'ai jamais fais la suppression d'un code dans le même fichier sur lequel est exécuter le code... et j'ai pas le temps de me pencher sur la question... mais cette méthode fonctionne.

Fred

Edit : fichier tester sur Excel 365 pro

Le 25/09/2020 à 12:13

en relisant tes message je viens de voir quelque chose...

moi j'avais donner cette ligne de code :

SendKeys Password & "~~~"

et toi tu as mis :

SendKeys Password & "mdp"

hors il faut laisser les "~~~" et le mot de passe doit être passer en paramètre de la fonction "mdp" et pas dans le code....

si tu ne sais pas faire un appel de fonction avec paramètre voir mon fichier précédent ou cette ligne tout simplement :

UnprotectVBProject ActiveWorkbook, "mdp"

Fred

Le 25/09/2020 à 15:27

Bonjour Fred,

Merci beaucoup pour toutes tes réponses et ton aide.

Finalement mon dernier point bloquant été l'appel à la fonction de ton dernier post.

Pour ceux qui voudrait voir le code complet le voici

Private Sub Workbook_BeforeClose(Cancel As Boolean)
moisannee = Format(Date, "yyyy-mm-dd")

Sheets("légende").Activate

If DateDiff("m", Range("B" & 11).Value, Now, vbMonday, vbFirstJan1) >= 1 Then
    If MsgBox("L'archivage du fichier va être réalisée. Les informations que vous avez modifier peuvent-elles être enregistrer?" & vbCrLf & "(Si oui merci de ne pas intérrompre les 3 enregistrements qui vont suivre)", vbYesNo) = vbNo Then
    Exit Sub
    Else
        Range("B" & 11) = moisannee
            ActiveWorkbook.Save
            ActiveWorkbook.SaveAs Filename:= _
            "C:\Users\JC5860BN\Desktop\a suppr\save auto\Suivi modifications départs " & moisannee & ".xlsm", _
            FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

            UnprotectVBProject ActiveWorkbook, "mdp" 
            DoEvents
            Supprimer_Macro_Precise
    End If
End If
End Sub
Sub UnprotectVBProject(WB As Workbook, ByVal Password As String)
Dim vbProj As Object
Set vbProj = WB.VBProject
If vbProj.Protection <> 1 Then Exit Sub
Set Application.VBE.ActiveVBProject = vbProj
SendKeys Password & "~~~"
Application.VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True).Execute
End Sub
Sub Supprimer_Macro_Precise()

Dim Debut As Integer, Lignes As Integer
Dim NomMod As String, NomMacro As String

NomMod = "ThisWorkbook"
NomMacro = "Workbook_BeforeClose"

With ThisWorkbook.VBProject.VBComponents(NomMod).CodeModule
    Debut = .ProcStartLine(NomMacro, 0)
    Lignes = .ProcCountLines(NomMacro, 0)
    .DeleteLines Debut, Lignes
    ActiveWorkbook.Save
End With
End Sub

Encore merci pour le coup de main.

Le 25/09/2020 à 15:51

Re

donc en fait le problème aurait pû être régler depuis presque 3 semaines.... si tu avais correctement copier les informations que j'avais donner ici :

https://forum.excel-pratique.com/excel/suppression-de-macro-bloquer-par-mdp-macro-145966#p898498

Dommage..

Bonne continuation

Fred

Le 25/09/2020 à 15:59

C'est bien ça.

Je ne connaissais pas les appels de fonction avec paramètre donc j'ai bêtement modifier en pensant qu'il fallait mon mdp.

Bonne continuation à toi aussi.

Rechercher des sujets similaires à "suppression macro bloquer mdp"