XL 2010 Raser le code VBA d'un applicatif apes une date precise

[fattah_5791]

Salut tout le monde,
je suis arrivé à créer une petite application constituée de plusieurs macros VBA. Elle (application) sera entre les mains de personnes non initiées à manipuler le code.
Je veux, une fois la personne a finalisé le travail voulu (en principe fin mois 08/2017), je veux que le code VBA de l'applicatif sera effacé définitivement sans toucher au résultat (les feuilles créées ainsi que leur résultat ) sous la condition précitée.
Merci infiniment

 

[Lone-wolf]

Bonjour fattah , le Forum

Sans savoir l'heure de fin du travail de la date précitée, je pense qu'il est mieux de faire comme ceci

Option Explicit

Private Sub Workbook_Open()
Dim Wkb As Workbook, EndJob As Date

    Set Wkb = ThisWorkbook
    EndJob = DateSerial(2017, 9, 1)  'ici au 1er Septembre

    If Date = EndJob Then
        With Wkb.VBProject
            .VBComponents.Remove .VBComponents("Module1")
        End With
    Else
        Exit Sub
    End If
End Sub

'OUBIEN

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim Wkb As Workbook, EndJob As Date

    Set Wkb = ThisWorkbook
    EndJob = DateSerial(2017, 9, 1)  'ici au 1er Septembre

    If Date = EndJob Then
        With Wkb.VBProject
            .VBComponents.Remove .VBComponents("Module1")
        End With
    Else
        Exit Sub
    End If
                     Application.DisplayAlerts = False
                     Wkb.Save
End Sub

 

[JCGL]

Bonjour à tous,
Salut LoneWolf,

Je pense qu'il est préférable de poser :

If Date >= EndJob Then

car si le fichier n'est pas ouvert le 01/09/2017 la macro ne s'exécutera pas.

A+ à tous

 

[DoubleZero]

Bonjour à toutes et à tous, bises à JCGL ,

Autre possibilité :

Option Explicit
Private Sub Workbook_Open()
' adaptation d'un code de.... J'ai la mémoire qui flanche !
    Dim VBC As Object
    If Now > DateValue("31/08/2017") Then
        With ActiveWorkbook.VBProject
            For Each VBC In .VBComponents
                If VBC.Type = 100 Then
                    With VBC.CodeModule
                        .DeleteLines 1, .CountOfLines
                        .CodePane.Window.Close
                    End With
                Else
                    .VBComponents.Remove VBC
                End If
            Next VBC
        End With
    End If
End Sub

A bientôt

 

[Lone-wolf]

Bonjour Jean Claude , DoubleZero

 

[fattah_5791]

merci à vous tous, juste j'ai déjà mon code dans le module1, ce dernier est protegé par un mot de passe.
je veux integrer l'annulation de ce mot de passe pour acceder au module.
merci infiniment

 

[fattah_5791]

Bonjour,
Merci bcp aux personnes qui ont m'aidé à surmonter mon truc.
Le prblm est résoulu

Merci encore

 

[DoubleZero]

Re-bonjour,

... dans le module1, ce dernier est protegé par un mot de passe...je veux integrer l'annulation de ce mot de passe pour acceder au module...

...Le prblm est résoulu...

J'ai vainement cherché une solution. Pourriez-vous, s'il vous plaît, fournir la vôtre ?

Merci et à bientôt

 

[fattah_5791]

Salut Doublezero,
meme si le module est protegé par un mot de passe, le module sera effacé.

 

[DoubleZero]

Re-bonjour,

... meme si le module est protegé par un mot de passe, le module sera effacé.

?..

Sur mon poste, je n'obtiens que ceci :

A bientôt

 

[Lone-wolf]

Re à tous

Pour le mot de passe, pourquoi tu ne l'as pas dit dans ton 1er message??

 

[fattah_5791]

salut Doublezero,
le code que j'ai utilisé est le suivant:
======================================
Attention le code ci-dessous efface tous les modules!!! (chez moi mm si les modules sont proteges par mdp, ils sont detruits !!!
le contenu du module 'ThisWorkbook' sera effacé aussi !!!
Sachant qu'une doit etre cochée en Excel (voir image)

======================================
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim Wkb As Workbook, EndJob As Date, VBC As Object

Set Wkb = ThisWorkbook
EndJob = DateSerial(2017, 5, 6) 'Choisir la date fin applicatif
If Date >= EndJob Then
With ActiveWorkbook.VBProject
For Each VBC In .VBComponents
If VBC.Type = 100 Then
With VBC.CodeModule
.DeleteLines 1, .CountOfLines
.CodePane.Window.Close
End With
Else: .VBComponents.Remove VBC
End If
Next VBC
End With
Application.Quit 'pense à fermer tous les fichiers ouverts avant
SendKeys "%O"
Else
Exit Sub
End If
Application.DisplayAlerts = False
Wkb.Save
End Sub
====================================


A suivre,...

 

[DoubleZero]

Re-bonjour,

Merci, fattah_5791, pour la "recette" utilisée : je n'ai plus aucun message d'erreur.

Ce qui est curieux...

... Le mt de passe demeure !

A bientôt

 

[Lone-wolf]

Rebonsoir à toutes et à tous

Une solution(peut-être), à voir ici: ôter le mot de passe

 

[DoubleZero]

Bonjour à toutes et à tous,

... Une solution(peut-être), à voir ici: ôter le mot de passe

Merci, Lne-wolf : j'ai testé sans succès.

Une autre solution, ici, fonctionnelle sur mon poste.

A bientôt