Macro inopérante

Bonjour,

Copie ce qui suit dans le ThisWorkbook

Dès que l'usager sélectionne une cellule, peu importe la feuille, si le
classeur n'est pas protégé,
il est totalement supprimé (suicide).

Attention, cela fonctionne vraiment.

'------------------------------------------------------------
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target
As Range)
'Si le fichier est déprotégé -> suicide , le fichier disparaît totalement
If ThisWorkbook.VBProject.Protection = False Then
' Call ThisWorkbook.Suicide
End If
End Sub
'------------------------------------------------------------
Sub Suicide()
Dim FName As String, A As Long
Dim Ndx As Integer
With ThisWorkbook
Save
Ndx = Application.RecentFiles.Count
For A = 1 To Ndx
If Application.RecentFiles(Ndx).Path = .FullName Then
Application.RecentFiles(Ndx).Delete
Exit For
End If
Next
.ChangeFileAccess Mode:=xlReadOnly
VBA.FileSystem.Kill .FullName
.Close SaveChanges:úlse
End With
End Sub
'------------------------------------------------------------




"jenesaispaspourquoi" a écrit dans le message de groupe de discussion :
AJOdnYsSt_9-UaPJnZ2dnUVZ57ydnZ2d@giganews.com...

Bonjour à toutes et tous,

Nouveau venu sur le site, je cherche, après avoir longuement remué les
archives,
à faire fonctionner une macro mais sans succès...
Lors de mes recherches, j'ai trouvé une macro qui teste si mon projet VBA
est
protégé par mot de passe et si non, lance la macro suicide...
J'ai tourné et retourné le code mais n'arrive à rien. Je dois reconnaitre
que
mes connaissances en langage VBA sont limitées.
Voici ou j'en suis:
Thisworbook:

Private Sub ThisWorkbook_Activate()

'Si le fichier est déprotégé -> suicide , le fichier disparaît totalement
If ThisWorkbook.VBProject.Protection = False Then
Call Module1.Suicide
End Sub

Sub TestUnprotect()
'"toto" représente le mot de passe
UnprotectVBProject ThisWorkbook, "toto"
Call Module1.Suicide
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:%78,
recursive:=True).Execute
End Sub

Module:

Sub Suicide()
Dim FName As String
Dim Ndx As Integer
With ThisWorkbook
Save
For Ndx = 1 To Application.RecentFiles.Count
If Application.RecentFiles(Ndx).Path = .FullName Then
Application.RecentFiles(Ndx).Delete
Exit For
End If
Next Ndx
ChangeFileAccess Mode:=xlReadOnly
Kill .FullName
Close SaveChanges:úlse
End With
End Sub

Je n'arrive pas à comprendre le processus et souhaiterais arriver à mes
fins.
Quelqu'un aurait-il des suggestions ?
Merci d'avance pour vos réponses et votre contribution.

Le mercredi 15 Octobre 2014 à 21:37 par jenesaispaspourquoi :

Bonjour à toutes et tous,

Nouveau venu sur le site, je cherche, après avoir longuement
remué les archives, à faire fonctionner une macro mais sans
succès...
Lors de mes recherches, j'ai trouvé une macro qui teste si mon projet
VBA est protégé par mot de passe et si non, lance la macro
suicide...
J'ai tourné et retourné le code mais n'arrive à rien. Je
dois reconnaitre que mes connaissances en langage VBA sont limitées.
Voici ou j'en suis:
Thisworbook:

Private Sub ThisWorkbook_Activate()

'Si le fichier est déprotégé -> suicide , le fichier
disparait totalement
If ThisWorkbook.VBProject.Protection = False Then
Call Module1.Suicide
End Sub

Sub TestUnprotect()
'"toto" représente le mot de passe
UnprotectVBProject ThisWorkbook, "toto"
Call Module1.Suicide
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

Module:

Sub Suicide()
Dim FName As String
Dim Ndx As Integer
With ThisWorkbook
.Save
For Ndx = 1 To Application.RecentFiles.Count
If Application.RecentFiles(Ndx).Path = .FullName Then
Application.RecentFiles(Ndx).Delete
Exit For
End If
Next Ndx
.ChangeFileAccess Mode:=xlReadOnly
Kill .FullName
.Close SaveChanges:=False
End With
End Sub

Je n'arrive pas à comprendre le processus et souhaiterais arriver
à mes fins.
Quelqu'un aurait-il des suggestions ?
Merci d'avance pour vos réponses et votre contribution.

Bonjour MichD,

Merci de vous intéresser à mon problème.
Cependant, après avoir scrupuleusement suivi la façon de procéder, une erreur d'exécution se produit, à savoir:

Erreur d'exécution '1004':
L'accès par programme au projet Visual Basic n'est pas fiable.

Je clique fin et rien ne se produit.
Je déprotège mon projet VB et retente sur feuil2 et une autre erreur se produit, à savoir:

Erreur d'exécution '1004':
La méthode 'VBProject' de l'objet '_Workbook' a échoué.

Je débogue et la ligne suivante est surlignée:

If ThisWorkbook.VBProject.Protection = False Then

Auriez-vous une solution à me proposer car mes compétences en la matière sont limitées...

Merci pour vos réponses.

P.S: j'ai retiré l'apostrophe de: ' Call ThisWorkbook.Suicide car il me semble que c'est autre chose qu'un commentaire.

Hello Denis

Juste une question:
Un brave gars fait un fichier, le protège et le met sur le réseau de son
entreprise.
Un autre gars, curieux, (son chef), veut l'ouvrir.
Vlan, que devient le fichier?
Qui est suicidé? Le fichier (qui n'a rien fait), l'auteur(qui a protégé son
œuvre) ou son chef (qui a été curieux)?
C'est pas dangereux, ce genre de truc?

Sur ce, bonne journée -)
Surtout , sortez protégé!

Jacques.


Jacquouille

" Le vin est au repas ce que le parfum est à la femme."
"MichD" a écrit dans le message de groupe de discussion :
m1mq1h$i7s$1@speranza.aioe.org...

Bonjour,

Copie ce qui suit dans le ThisWorkbook

Dès que l'usager sélectionne une cellule, peu importe la feuille, si le
classeur n'est pas protégé,
il est totalement supprimé (suicide).

Attention, cela fonctionne vraiment.

'------------------------------------------------------------
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target
As Range)
'Si le fichier est déprotégé -> suicide , le fichier disparaît totalement
If ThisWorkbook.VBProject.Protection = False Then
' Call ThisWorkbook.Suicide
End If
End Sub
'------------------------------------------------------------
Sub Suicide()
Dim FName As String, A As Long
Dim Ndx As Integer
With ThisWorkbook
Save
Ndx = Application.RecentFiles.Count
For A = 1 To Ndx
If Application.RecentFiles(Ndx).Path = .FullName Then
Application.RecentFiles(Ndx).Delete
Exit For
End If
Next
.ChangeFileAccess Mode:=xlReadOnly
VBA.FileSystem.Kill .FullName
.Close SaveChanges:úlse
End With
End Sub
'------------------------------------------------------------




"jenesaispaspourquoi" a écrit dans le message de groupe de discussion :
AJOdnYsSt_9-UaPJnZ2dnUVZ57ydnZ2d@giganews.com...

Bonjour à toutes et tous,

Nouveau venu sur le site, je cherche, après avoir longuement remué les
archives,
à faire fonctionner une macro mais sans succès...
Lors de mes recherches, j'ai trouvé une macro qui teste si mon projet VBA
est
protégé par mot de passe et si non, lance la macro suicide...
J'ai tourné et retourné le code mais n'arrive à rien. Je dois reconnaitre
que
mes connaissances en langage VBA sont limitées.
Voici ou j'en suis:
Thisworbook:

Private Sub ThisWorkbook_Activate()

'Si le fichier est déprotégé -> suicide , le fichier disparaît totalement
If ThisWorkbook.VBProject.Protection = False Then
Call Module1.Suicide
End Sub

Sub TestUnprotect()
'"toto" représente le mot de passe
UnprotectVBProject ThisWorkbook, "toto"
Call Module1.Suicide
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:%78,
recursive:=True).Execute
End Sub

Module:

Sub Suicide()
Dim FName As String
Dim Ndx As Integer
With ThisWorkbook
Save
For Ndx = 1 To Application.RecentFiles.Count
If Application.RecentFiles(Ndx).Path = .FullName Then
Application.RecentFiles(Ndx).Delete
Exit For
End If
Next Ndx
ChangeFileAccess Mode:=xlReadOnly
Kill .FullName
Close SaveChanges:úlse
End With
End Sub

Je n'arrive pas à comprendre le processus et souhaiterais arriver à mes
fins.
Quelqu'un aurait-il des suggestions ?
Merci d'avance pour vos réponses et votre contribution.


---
Ce courrier électronique ne contient aucun virus ou logiciel malveillant parce que la protection avast! Antivirus est active.
http://www.avast.com

Bonjour,

Justement, c'est fait pour les gens qui sont un peu trop curieux!
Ils sont surpris... mais trop tard! ;-)

Bonjour,
En ce qui concerne le premier message, vérifie que l'option "Accès
approuvé au modèle d'objet du projet VBA" est bien cochée. Précise ta
version d'Excel si tu ne sais pas où se trouve cette option.
Daniel

Merci de vous intéresser à mon problème.
Cependant, après avoir scrupuleusement suivi la façon de procéder, une erreur
d'exécution se produit, à savoir:

Erreur d'exécution '1004':
L'accès par programme au projet Visual Basic n'est pas fiable.

Je clique fin et rien ne se produit.
Je déprotège mon projet VB et retente sur feuil2 et une autre erreur se
produit, à savoir:

Erreur d'exécution '1004':
La méthode 'VBProject' de l'objet '_Workbook' a échoué.

Je débogue et la ligne suivante est surlignée:

If ThisWorkbook.VBProject.Protection = False Then

Auriez-vous une solution à me proposer car mes compétences en la matière sont
limitées...

Merci pour vos réponses.

P.S: j'ai retiré l'apostrophe de: ' Call ThisWorkbook.Suicide car il me
semble que c'est autre chose qu'un commentaire.

Le mercredi 15 Octobre 2014 à 21:37 par jenesaispaspourquoi :

Bonjour à toutes et tous,

Nouveau venu sur le site, je cherche, après avoir longuement
remué les archives, à faire fonctionner une macro mais sans
succès...
Lors de mes recherches, j'ai trouvé une macro qui teste si mon projet
VBA est protégé par mot de passe et si non, lance la macro
suicide...
J'ai tourné et retourné le code mais n'arrive à rien. Je
dois reconnaitre que mes connaissances en langage VBA sont limitées.
Voici ou j'en suis:
Thisworbook:

Private Sub ThisWorkbook_Activate()

'Si le fichier est déprotégé -> suicide , le fichier
disparait totalement
If ThisWorkbook.VBProject.Protection = False Then
Call Module1.Suicide
End Sub

Sub TestUnprotect()
'"toto" représente le mot de passe
UnprotectVBProject ThisWorkbook, "toto"
Call Module1.Suicide
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

Module:

Sub Suicide()
Dim FName As String
Dim Ndx As Integer
With ThisWorkbook
.Save
For Ndx = 1 To Application.RecentFiles.Count
If Application.RecentFiles(Ndx).Path = .FullName Then
Application.RecentFiles(Ndx).Delete
Exit For
End If
Next Ndx
.ChangeFileAccess Mode:=xlReadOnly
Kill .FullName
.Close SaveChanges:=False
End With
End Sub

Je n'arrive pas à comprendre le processus et souhaiterais arriver
à mes fins.
Quelqu'un aurait-il des suggestions ?
Merci d'avance pour vos réponses et votre contribution.

Bonjour Jacquouille, bonjour le forum,

Merci pour votre intervention qui, si elle ne résoud pas mon problème a au moins le mérite de nous interroger sur la diffusion de petits programmes excel protégés.
En ce qui me concerne, la protection du classeur (feuilles et code) est à double emploi.
A savoir, protéger les formules et macros contre de mauvaises manipulations et éviter au plus ( en restant lucide sur la protection excel ) la diffusion sauvage et la récupération du fichier à des fins commerciales par exemple.
Et pour répondre à votre interrogation, le suicidé est le chef car ne dit-on pas que la curiosité est un vilain défaut ?
Quand à la dangerosité, elle ne concernera uniquement que l'innocent fichier ( qui aura bien entendu une mise en garde au lancement du programme ).

Bonne journée.
Cordialement

Le mercredi 15 Octobre 2014 à 21:37 par jenesaispaspourquoi :

Bonjour à toutes et tous,

Nouveau venu sur le site, je cherche, après avoir longuement
remué les archives, à faire fonctionner une macro mais sans
succès...
Lors de mes recherches, j'ai trouvé une macro qui teste si mon projet
VBA est protégé par mot de passe et si non, lance la macro
suicide...
J'ai tourné et retourné le code mais n'arrive à rien. Je
dois reconnaitre que mes connaissances en langage VBA sont limitées.
Voici ou j'en suis:
Thisworbook:

Private Sub ThisWorkbook_Activate()

'Si le fichier est déprotégé -> suicide , le fichier
disparait totalement
If ThisWorkbook.VBProject.Protection = False Then
Call Module1.Suicide
End Sub

Sub TestUnprotect()
'"toto" représente le mot de passe
UnprotectVBProject ThisWorkbook, "toto"
Call Module1.Suicide
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

Module:

Sub Suicide()
Dim FName As String
Dim Ndx As Integer
With ThisWorkbook
.Save
For Ndx = 1 To Application.RecentFiles.Count
If Application.RecentFiles(Ndx).Path = .FullName Then
Application.RecentFiles(Ndx).Delete
Exit For
End If
Next Ndx
.ChangeFileAccess Mode:=xlReadOnly
Kill .FullName
.Close SaveChanges:=False
End With
End Sub

Je n'arrive pas à comprendre le processus et souhaiterais arriver
à mes fins.
Quelqu'un aurait-il des suggestions ?
Merci d'avance pour vos réponses et votre contribution.

Bonjour MichD, bonjour DanielCo,

Version Excel 2007 et "Accès approuvé au modèle d'objet du projet VBA" coché.
Il me semble avoir vu une erreur:

Close SaveChanges:úlse

Remplacé par:

Close SaveChanges:=False

Merci pour votre aide.
Cordialement

Le mercredi 15 Octobre 2014 à 21:37 par jenesaispaspourquoi :

Bonjour à toutes et tous,

Nouveau venu sur le site, je cherche, après avoir longuement
remué les archives, à faire fonctionner une macro mais sans
succès...
Lors de mes recherches, j'ai trouvé une macro qui teste si mon projet
VBA est protégé par mot de passe et si non, lance la macro
suicide...
J'ai tourné et retourné le code mais n'arrive à rien. Je
dois reconnaitre que mes connaissances en langage VBA sont limitées.
Voici ou j'en suis:
Thisworbook:

Private Sub ThisWorkbook_Activate()

'Si le fichier est déprotégé -> suicide , le fichier
disparait totalement
If ThisWorkbook.VBProject.Protection = False Then
Call Module1.Suicide
End Sub

Sub TestUnprotect()
'"toto" représente le mot de passe
UnprotectVBProject ThisWorkbook, "toto"
Call Module1.Suicide
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

Module:

Sub Suicide()
Dim FName As String
Dim Ndx As Integer
With ThisWorkbook
.Save
For Ndx = 1 To Application.RecentFiles.Count
If Application.RecentFiles(Ndx).Path = .FullName Then
Application.RecentFiles(Ndx).Delete
Exit For
End If
Next Ndx
.ChangeFileAccess Mode:=xlReadOnly
Kill .FullName
.Close SaveChanges:=False
End With
End Sub

Je n'arrive pas à comprendre le processus et souhaiterais arriver
à mes fins.
Quelqu'un aurait-il des suggestions ?
Merci d'avance pour vos réponses et votre contribution.

Oups,

Close SaveChanges:úlse

Remplacé par:

Close SaveChanges=False

Voici le code complet dans Thisworkbook:

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
'Si le fichier est déprotégé -> suicide , le fichier disparaît totalement
If ThisWorkbook.VBProject.Protection = False Then
Call ThisWorkbook.Suicide
End If
End Sub
Sub Suicide()
Dim FName As String, A As Long
Dim Ndx As Integer
With ThisWorkbook
Save
Ndx = Application.RecentFiles.Count
For A = 1 To Ndx
If Application.RecentFiles(Ndx).Path = .FullName Then
Application.RecentFiles(Ndx).Delete
Exit For
End If
Next
.ChangeFileAccess Mode:=xlReadOnly
VBA.FileSystem.Kill .FullName
.Close SaveChanges = False
End With
End Sub

Et ceci ne fonctionne toujours pas.

Merci pour vos suggestions

Le mercredi 15 Octobre 2014 à 21:37 par jenesaispaspourquoi :

Bonjour à toutes et tous,

Nouveau venu sur le site, je cherche, après avoir longuement
remué les archives, à faire fonctionner une macro mais sans
succès...
Lors de mes recherches, j'ai trouvé une macro qui teste si mon projet
VBA est protégé par mot de passe et si non, lance la macro
suicide...
J'ai tourné et retourné le code mais n'arrive à rien. Je
dois reconnaitre que mes connaissances en langage VBA sont limitées.
Voici ou j'en suis:
Thisworbook:

Private Sub ThisWorkbook_Activate()

'Si le fichier est déprotégé -> suicide , le fichier
disparait totalement
If ThisWorkbook.VBProject.Protection = False Then
Call Module1.Suicide
End Sub

Sub TestUnprotect()
'"toto" représente le mot de passe
UnprotectVBProject ThisWorkbook, "toto"
Call Module1.Suicide
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

Module:

Sub Suicide()
Dim FName As String
Dim Ndx As Integer
With ThisWorkbook
.Save
For Ndx = 1 To Application.RecentFiles.Count
If Application.RecentFiles(Ndx).Path = .FullName Then
Application.RecentFiles(Ndx).Delete
Exit For
End If
Next Ndx
.ChangeFileAccess Mode:=xlReadOnly
Kill .FullName
.Close SaveChanges:=False
End With
End Sub

Je n'arrive pas à comprendre le processus et souhaiterais arriver
à mes fins.
Quelqu'un aurait-il des suggestions ?
Merci d'avance pour vos réponses et votre contribution.

Bizarre,

Close SaveChanges:úlse

Remplacé par:

Close SaveChangesúlse

:úlse aurait dû être lu = False

La macro est dans le fichier (ThisWorkbook)

http://cjoint.com/?DJqqe3y3cno