Discussion :

[kyasteph]

Bonjour

J'ai un programme que j'ai crée et je souhaite créer une macro qui supprime tous mes codes (macros) y compris le contenu de thisworkbook;ceci au cas ou celui qui n'a pas droit d'utiliser le copie sur son pc.
j'ai cherché sur le net et dans ce forum;j'ai trouvé une qui fonctionne bien mais seulement quand mon projet vb est déjà déverouillé.
Alors qu'il faut bien qu'il soit protégé!

Voici le code:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
 
 
Sub SupprimerModule(NomModule As String)
     With ThisWorkbook.VBProject.VBComponents(NomModule).CodeModule
         .DeleteLines 1, .CountOfLines
     End With
     With ActiveWorkbook.VBProject
    'cette partie du code est de Laurent Longre
     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 Sub
 
Sub essai()
SupprimerModule "ThisWorkbook"
End Sub

Quand je l'exécute,un message d'erreur s'affiche:"Erreur d'exécution '50289':impossible d'effectuer cette opération tant que le projet est protégé"

Alors je pense à une solution comme on le fait pour déprotéger les feuilles en incluant le mot de pass dans la macro...;mais je ne sais comment y arriver.

quelqu'un peut il m'aider.merci d'avance.

[NVCfrm]

Salut kyasteph,

Ce problème est mineur à côté de l'éventualité où dans les paramètres de sécurité d'Excel l'accès approuvé au modèle Objet VBA est décoché.
As tu songé à cela?

[BlueMonkey]

Bonsoir,

Une façon de faire pour les formats récents de fichier Excel est d'enregistrer le fichier au fomat xlsx (ce qui a pour conséquence de supprimer les macros).

Attention de bien sauvegarder son classeur avec les macros.
Et ça ne fonctionne que si l'utilisateur a accès en écriture au fichier Excel contenant la macro.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
Private Sub Workbook_Open()
    Dim MonFichierAProteger As String
    MonFichierAProteger = ThisWorkbook.Path & "\" & ThisWorkbook.Name
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    With ThisWorkbook
        .SaveAs Left(.Name, Len(.Name) - 5), xlOpenXMLWorkbook
    End With
    Kill MonFichierAProteger
    Workbooks.Open ThisWorkbook.Path & "\" & ThisWorkbook.Name
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

[NVCfrm]

bonsoir BlueMonkey,
alternative interresante à laquelle je ne pensais pas.

[Didier Gonard]

Bonjour,

tu peux essayer d'employer le célèbre code de Bill Manville

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
'Code de Bill Manville
Sub TestProtect()
Workbooks.Add.SaveAs "C:\Temp\Book1.xls"
ProtectVBProject Workbooks("Book1.xls"), "Jack"
Workbooks("Book1.xls").Close True
End Sub
Sub TestUnprotect()
Workbooks.Open "C:\Temp\Book1.xls"
UnprotectVBProject Workbooks("Book1.xls"), "Jack"
End Sub
Sub UnprotectVBProject(WB As Workbook, ByVal Password As String)
Dim vbProj As Object
Set vbProj = WB.VBProject
'can't do it if already unlocked!
If vbProj.Protection <> 1 Then Exit Sub
Set Application.VBE.ActiveVBProject = vbProj
' now use lovely SendKeys to quote the project password
SendKeys Password & "~~"
Application.VBE.CommandBars(1).FindControl(Id:=2578,recursive:=True).Execute
End Sub
Sub ProtectVBProject(WB As Workbook, ByVal Password As String)
Dim vbProj As Object
Set vbProj = WB.VBProject
'can't do it if already locked!
If vbProj.Protection = 1 Then Exit Sub
Set Application.VBE.ActiveVBProject = vbProj
' now use lovely SendKeys to set the project password
SendKeys "+{TAB}{RIGHT}%V{+}{TAB}" & Password & "{TAB}" & _
Password & "~"
Application.VBE.CommandBars(1).FindControl(Id:=2578,recursive:=True).Execute
WB.Save
End Sub

cordialement,

Didier

[kyasteph]

Bonjour,
merci encore pour toutes vos réponses,vos contributions m'ont permises de resoudre mon probleme.
Mille fois merci à tous car vous n'hesitez pas à partager vos connaissances;competences experiences souvent acquises au prix de beaucoup d'efforts et de sacrifices et cela à titre gratuit.
Dieu vous bénisse et longue vie au forum.