Mission Impossible

[Ilino]

Bonjour Forum
Ciao a tutti .. Ciao Forum
Mission Impossible
Je cherche un code qui fait supprimer toutes les données des onglets après une date bien définie est il possibl ???
Grazie

 

[Ilino]

Re : Mission Impossible

Ta demande était : comment déprotéger par macro un fichier dont le projet VBA est protégé.
La solution proposée me semble répondre à ta demande.
Une fois déprotégé, le code proposé par Efgé doit donc pouvoir faire son travail.
A+

Re DAVID
MERCI pour la réponse mais je n'arrive pas comprendre pourquoi deux fichiers ??
A+

 

[Yohan]

Re : Mission Impossible

ben le problème c'est que je vois pas le but car le code de TOM supprime toute les feuilles actuelles et même les macros donc en gros cela revient à ouvrir un fichier excel vide.

Et sans voir le but il est difficile de répondre à la demande. Car ta date serai rentrer où ??? c'est le nom de ta feuille la date ??

Pour protéger le code j'aurai pas mis le code à l'ouverture du fichier car la tu pers tout mais à l'ouverture de VBA mais je sais pas si cela est possible

 

[david84]

Re : Mission Impossible

Bonjour,

MERCI pour la réponse mais je n'arrive pas comprendre pourquoi deux fichiers ??

As-tu seulement lu le lien que je t'avais indiqué ? Les explications me semblent pourtant claires et même si c'est en anglais tu peux utiliser un outil de traduction (celui de Google par exemple).

Comme, suite au travail fourni par Efgé tu bloquais sur le fait que le code de Efgé ne fonctionnait pas lorsque le fichier était protégé via le projet VBA (ce qui est tout à fait logique d'ailleurs) je n'ai fait que rechercher une possibilité qui pourrait te permettre de sortir de l'impasse (mais il en existe sûrement d'autres).

Les 2 fichiers fournis ne sont que la retranscription automatisée de la procédure expliquée dans le lien.
Le but de cette proposition était simplement de te permettre de trouver un début de piste de travail à creuser par la suite.

J'ai continué de suivre la même logique mais cette fois-ci en créant un fichier temporaire qui fait le travail et qui s'autodétruit immédiatement à la fin (comme le message dans mission impossible d'ailleurs...).

Voici la procédure :

Sub DeprotegerProjetVBA()
Dim NomClasseur As String
If Application.VBE.ActiveVBProject.Protection <> 0 Then
    NomClasseur = ThisWorkbook.Path & "\FichierTemp.xls"
    Workbooks.Open Filename:=NomClasseur
    Application.Run "'FichierTemp.xls'!Sample"
    Workbooks("FichierTemp.xls").Close SaveChanges:=False
End If
End Sub

Sub Procedure()
Application.ScreenUpdating = False
If Application.VBE.ActiveVBProject.Protection <> 0 Then
    Call CreerClasseur
    Call DeprotegerProjetVBA
    Call SupprimerClasseur
End If
Application.ScreenUpdating = True
End Sub

Sub SupprimerClasseur()
Dim chemin As String, nf As String
nf = ThisWorkbook.Path & "\FichierTemp.xls"
chemin = Dir(nf)
If chemin <> "" Then Kill (nf)
End Sub

Sub CreerClasseur()
Dim xlBook As Workbook
Dim xlModule As Object, i As Long
Application.DisplayAlerts = False
Set xlBook = Workbooks.Add
Set xlModule = xlBook.VBProject.VBComponents.Add(1)
With xlModule.CodeModule
    i = .CountOfLines
    .InsertLines i, "Sub Sample()": i = i + 1
    .InsertLines i, "UnprotecPassword Workbooks(""Unprotect_VBA_Project.xls""), ""do""": i = i + 1
    .InsertLines i, "End Sub": i = i + 1
    .InsertLines i, "Sub UnprotecPassword(wb As Workbook, ByVal projectPassword As String)": i = i + 1
    .InsertLines i, "Dim currentActiveWb As Workbook": i = i + 1
    .InsertLines i, "If wb.VBProject.Protection <> 1 Then": i = i + 1
    .InsertLines i, "Exit Sub": i = i + 1
    .InsertLines i, "End If": i = i + 1
    .InsertLines i, "Set currentActiveWb = ActiveWorkbook": i = i + 1
    .InsertLines i, "wb.Activate": i = i + 1
    .InsertLines i, "SendKeys ""^r""": i = i + 1
    .InsertLines i, "SendKeys ""{TAB}""": i = i + 1
    .InsertLines i, "SendKeys ""~""": i = i + 1
    .InsertLines i, "SendKeys projectPassword": i = i + 1
    .InsertLines i, "SendKeys ""~""": i = i + 1
    .InsertLines i, "SendKeys ""{NUMLOCK}""": i = i + 1
    .InsertLines i, "If (wb.VBProject.Protection = 0) Then": i = i + 1
    .InsertLines i, "MsgBox (""failed to unlock"")": i = i + 1
    .InsertLines i, "End If": i = i + 1
    .InsertLines i, "currentActiveWb.Activate": i = i + 1
    .InsertLines i, "End Sub": i = i + 1
End With
xlBook.SaveAs Filename:= _
    ThisWorkbook.Path & "\FichierTemp.xls", FileFormat:=xlExcel8 _
    , Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
    CreateBackup:=False
xlBook.Close SaveChanges:=True
Application.DisplayAlerts = True
End Sub

Cette proposition est dans la continuité de la 1ère mais l'idée est présentement de créer un classeur temporaire et de le détruire à la fin : tu te retrouves donc avec un seul fichier.

Encore une fois, je n'ai faire que suivre puis développer l'idée proposée dans le lien mais peut-être y-a-t-il plus simple, peut-être n'a-t-on pas besoin de passer par la création de ce fichier temporaire, peut-être peut-on directement inclure un code de déprotection dans le fichier, bref à toi aussi de creuser la question.

Le fichier est enregistré en .xls et non .xlsm afin de permettre à ceux possédant Excel 2003 de tester.

A+

 

[david84]

Re : Mission Impossible

Re
Suite à mon message #33

Encore une fois, je n'ai faire que suivre puis développer l'idée proposée dans le lien mais peut-être y-a-t-il plus simple, peut-être n'a-t-on pas besoin de passer par la création de ce fichier temporaire, peut-être peut-on directement inclure un code de déprotection dans le fichier, bref à toi aussi de creuser la question.

J'ai fait un essai et apparemment on peut se passer de la création d'un fichier temporaire :

Sub Sample()
    UnprotecPassword Workbooks(ThisWorkbook.Name), "do"
End Sub

Sub UnprotecPassword(wb As Workbook, ByVal projectPassword As String)
    Dim currentActiveWb As Workbook

    If wb.VBProject.Protection <> 1 Then Exit Sub

    Set currentActiveWb = ActiveWorkbook
    wb.Activate
    SendKeys "%{F11}"
    SendKeys "^r" ' Set focus to Explorer
    SendKeys "{TAB}" ' Tab to locked project
    SendKeys "~" ' Enter
    SendKeys projectPassword
    SendKeys "~" ' Enter
    SendKeys "{NUMLOCK}"

    If (wb.VBProject.Protection = vbext_pp_locked) Then
        MsgBox ("failed to unlock")
    End If
    currentActiveWb.Activate
End Sub

Sub DeprotegerProjetVBA()
If Application.VBE.ActiveVBProject.Protection <> 0 Then Call Sample
End Sub

A+

 

[Ilino]

Re : Mission Impossible

Re DAVID
merci pour ces explications donc si j'ai bien compris ta logique : je rajoute ce code au code TOM(Efgé) est ça fonctionne!!!
mais malheureusement ça n'a pas fonctionné??? je suis désolé
A+

 

[david84]

Re : Mission Impossible

Re DAVID
merci pour ces explications donc si j'ai bien compris ta logique : je rajoute ce code au code TOM(Efgé) est ça fonctionne!!!
mais malheureusement ça n'a pas fonctionné??? je suis désolé
A+

Ce n'est pas du tout ce que j'ai dit.
Si tu as testé le dernier fichier et que le projet VBA est effectivement déprotégé après que tu aies lancé le code, c'est que ce code fonctionne.
Si après il ne fonctionne pas lorsque tu tentes de le mixer avec le code de Efgé c'est que tu dois mal t'y prendre.
On peut d'ailleurs simplifier la Sub UnprotecPassword puisque l'on vérifie déjà si le projet VBA est ou non protégé dans la Sub DeprotegerProjetVBA.
Le code complet devient donc :

Sub Sample()
    UnprotecPassword Workbooks(ThisWorkbook.Name), "do"
End Sub

Sub UnprotecPassword(wb As Workbook, ByVal projectPassword As String)
    Dim currentActiveWb As Workbook
    Set currentActiveWb = ActiveWorkbook
    wb.Activate
    SendKeys "%{F11}"
    SendKeys "^r" ' Set focus to Explorer
    SendKeys "{TAB}" ' Tab to locked project
    SendKeys "~" ' Enter
    SendKeys projectPassword
    SendKeys "~" ' Enter
    SendKeys "{NUMLOCK}"
    currentActiveWb.Activate
End Sub

Sub DeprotegerProjetVBA()
If Application.VBE.ActiveVBProject.Protection <> 0 Then Call Sample
End Sub

Mais je le répète : même si ce code fonctionne en l'état lorsque tu le testes sur mon fichier fourni dans mon précédent message tu dois maintenant nécessairement inclure ce code dans le cadre spécifique de ton fichier (et peut-être y apporter de légères modifications).
A+

 

[Ilino]

Re : Mission Impossible

re
grazie DAVID je vais le tester ...
A+
NB: ci rattaché le 1 jet de mon fichier (rassemblé Egfé et DAVID)

 

[david84]

Re : Mission Impossible

re
grazie DAVID je vais le tester ...
A+
NB: ci rattaché le 1 jet de mon fichier (rassemblé Egfé et DAVID)

Je ne vois pas le code fourni par Efgé dans ton fichier.
Le plus simple pour l'instant est de lancer le code via un bouton placé sur la feuille et non lors de l'ouverture du fichier (Sub Workbook_Open()).
Publie dans ton prochain message le code testé que je puisse comprendre ce que tu as tenté.
A+

 

[Ilino]

Re : Mission Impossible

Je ne vois pas le code fourni par Efgé dans ton fichier.

A+

Bonjour DAVID
Il est dans ThisWorkbook
Grazie

 

[david84]

Re : Mission Impossible

RE

Mais ce que tu fais n'est pas logique : si tu lances le code de Efgé dans la Sub Workbook_Open avant de lancer le code de déprotection cela ne peut pas fonctionner.

Même si le sujet n'est pas évident et que tu ne peux pas tout seul produire les codes fournis tu dois au moins essayer de comprendre la logique de la procédure : mon code déprotège le projet VBA et celui de Efgé supprime tout donc pose toi la question de savoir dans quel ordre tu dois lancer les codes.

Je te laisse réfléchir la-dessus et dois te laisser car je suis occupé par ailleurs.

Une dernière chose avant de te laisser : je pense que tu devras placer une temporisation dans ta procédure si cela ne fonctionne pas malgré le fait que ta procédure soit lancée dans le bon ordre : regarde dans l'aide d'Excel (touche F1) comment utiliser un timer (1 seconde entre les 2 codes devrait suffire).

Et avant de placer le lancement de la procédure lors de l'ouverture du fichier commence par la lancer à l'aide d'un bouton de commande (c'est plus simple pour tester).
Bon courage
A+

 

[david84]

Re : Mission Impossible

Re

Histoire de te faciliter les choses, j'ai testé de mon côté : pas besoin d'utiliser un timer entre les 2 procédures.
Il te suffit :
- de supprimer ce qu'il y a dans ThisWorkbook (pour l'instant)
- de placer le code de Efgé dans un module classique (soit dans le module1, soit tu crées un autre module et tu le colles dedans)
- dans la Sub DeprotegerProjetVBA() c'est là que tu dois appeler mon code de déprotection (ça c'est déjà fait) et le code de Efgé. Tu sépares les 2 procédures avec un DoEvents (sinon ça plante) et le tour est joué.
- tu crées un bouton sur la feuille de calcul et tu lui affectes la macro DeprotegerProjetVBA() afin de lancer la procédure.
Testé de mon côté : cela fonctionne (le code VBA est détruit que le classeur soit ou non protégé via le projet VBA).
Voilà je t'ai tout dit, tu n'as plus qu'à le faire par toi-même.
A+

 

[Ilino]

Re : Mission Impossible

RE


Je te laisse réfléchir la-dessus et dois te laisser car je suis occupé par ailleurs.


Bon courage
A+

Re merci pour la réponse et les remarques, si vous permettez ma logique( ou bien comme je vois les choses)
je souhaiterai créer un code qui supprime tous les codes du mon classeur ( fichiers) de cette maniere
1 - Déverrouiller le code de VBA ( ou bien désactiver le code ou le supprimer définitivement )
2 - vérifier la date ( d'autodetruit )
3 - en fin supprimer toutes les feuilles et les codes
voila ma logique
NB toutes ces codes doivent être automatique sans créer des boutons
GRAZIE DAVID

 

[david84]

Re : Mission Impossible

RE

je souhaiterai créer un code qui supprime tous les codes du mon classeur ( fichiers) de cette maniere
1 - Déverrouiller le code de VBA ( ou bien désactiver le code ou le supprimer définitivement )
2 - vérifier la date ( d'autodetruit )
3 - en fin supprimer toutes les feuilles et les codes

C'est bien ce que la procédure détaillée fait non ?
Si c'est le cas c'est que cela fonctionne (en tout cas chez moi cela fonctionne).

NB toutes ces codes doivent être automatique sans créer des boutons

Je t'ai bien précisé que le bouton n'était là que pour la phase de test. Rien ne t'empêchera une fois le code testé correctement d'appeler la procédure via la Sub Workbook_Open() et donc de supprimer le bouton.

si vous permettez ma logique( ou bien comme je vois les choses)

Je suis d'accord avec ce que tu as décrit mais alors pourquoi ne pas suivre ta logique ?
Tu énonces bien les 3 étapes dans l'ordre

1 - Déverrouiller le code de VBA ( ou bien désactiver le code ou le supprimer définitivement )
2 - vérifier la date ( d'autodetruit )
3 - en fin supprimer toutes les feuilles et les codes

mais pourtant tu fais l'inverse en lançant dans la Sub Workbook_Open le code de Efgé sans t'occuper du fait de déprotéger le projet VBA avant.
C'est cela qui ne me paraissait pas logique.
A+

 

[MJ13]

Re : Mission Impossible

Bonjour à tous

Pour supprimer toutes les lignes de code dans Thisworkbook, on peut utiliser ce code:

Code VBA:
Sub Supprimer_Lignes_CodeVBA_Thisworkbook()
ThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.DeleteLines 1, ThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.CountOfLines
End Sub




On peut remplacer This par Active .