Comment entrer le mot de passe du VBA dans un programme ?

Le
François
Bonjour,

Autre petite question :

Michdenis m'avait fourni un programme pour supprimer toutes les lignes de
programme d'un classeur.
Je voudrai adapter ce programme pour un autre fichier dont l'accès au VBA
est protégé par un mot de passe et je ne sais pas comment faire ?

Auriez-vous une piste .

Merci à tous

François

le programme de Michdenis :
Dim VBComp, VBComps As Object
Set VBComps = ActiveWorkbook.VBProject.VBComponents
For Each VBComp In VBComps
Select Case VBComp.Type
Case 100
With VBComp.CodeModule
.DeleteLines 1, .CountOfLines
End With
Case Else
VBComps.Remove VBComp
End Select
Next VBComp
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
MichDenis
Le #4751791
Dans la procédure originale de Bill Manville, il utilise ceci :
SendKeys "%{F11}%TE" & Password & "~~%{F11}", True

Mais comme Bill travaille sur une version anglaise, il faut traduire
les lettre TE pour Oe et la ligne de commande devient celle-ci :

SendKeys "%{F11}%Oe" & Password & "~~%{F11}", True

IMPORTANT : N'oublie pas de saisir le nom du fichier dont tu
veux déprotéger ton fichier dans la procédure "Test"

La procédure test doit être lancé à partir de l'interface de la
feuille de calcul et non à partir de la fenêtre de l'éditeur de code.

Cela devrait fonctionner pour les versions Excel 97 à Excel 2003.
Aucune idée pour la version 2007.

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub test()
Dim Wk As Workbook
'Ouvre le projet VBA
Set Wk = Workbooks("à détruire1.xls")

'Supprime toutes les procédures
UnprotectVBProject Wk, "denismichon"
Détruire_Le_Code Wk
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Sub UnprotectVBProject(WB As Workbook, ByVal Password As String)
'
' Bill Manville, 29-Jan-2000
' Que j'ai légèrement adapté en outre pour
' la version française d'excel et aussi pour
' se passer de la référence suivante :
' " Microsoft Visual Basic for Applications Extensibility 5.3"

Dim VBP As Object, oWin As Object
Dim wbActive As Workbook
Dim i As Integer

Set VBP = WB.VBProject
Set wbActive = ActiveWorkbook

If VBP.Protection <> 1 Then Exit Sub

Application.ScreenUpdating = False

' Close any code windows To ensure we hit the right project
For Each oWin In VBP.VBE.Windows
If InStr(oWin.Caption, "(") > 0 Then oWin.Close
Next oWin

WB.Activate
' now use lovely SendKeys To unprotect
Application.OnKey "%{F11}"
SendKeys "%{F11}%Oe" & Password & "~~%{F11}", True

If VBP.Protection = vbext_pp_locked Then
' failed - maybe wrong password
SendKeys "%{F11}%Oe", True
End If

' leave no evidence of the password
Password = ""
' go back To the previously active workbook
wbActive.Activate

End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Sub Détruire_Le_Code(Wk As Workbook)
Set VBComps = Wk.VBProject.VBComponents
For Each VBComp In VBComps
Select Case VBComp.Type
Case 100
With VBComp.CodeModule
.DeleteLines 1, .CountOfLines
End With
Case Else
VBComps.Remove VBComp
End Select
Next
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
MichDenis
Le #4751771
J'ai omis de modifier cette ligne de code dans la
procédure de Bill Manville :

| If VBP.Protection = vbext_pp_locked Then

Tu la remplaces par ceci :

If VBP.Protection = 1 Then




"MichDenis"
Dans la procédure originale de Bill Manville, il utilise ceci :
SendKeys "%{F11}%TE" & Password & "~~%{F11}", True

Mais comme Bill travaille sur une version anglaise, il faut traduire
les lettre TE pour Oe et la ligne de commande devient celle-ci :

SendKeys "%{F11}%Oe" & Password & "~~%{F11}", True

IMPORTANT : N'oublie pas de saisir le nom du fichier dont tu
veux déprotéger ton fichier dans la procédure "Test"

La procédure test doit être lancé à partir de l'interface de la
feuille de calcul et non à partir de la fenêtre de l'éditeur de code.

Cela devrait fonctionner pour les versions Excel 97 à Excel 2003.
Aucune idée pour la version 2007.

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub test()
Dim Wk As Workbook
'Ouvre le projet VBA
Set Wk = Workbooks("à détruire1.xls")

'Supprime toutes les procédures
UnprotectVBProject Wk, "denismichon"
Détruire_Le_Code Wk
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Sub UnprotectVBProject(WB As Workbook, ByVal Password As String)
'
' Bill Manville, 29-Jan-2000
' Que j'ai légèrement adapté en outre pour
' la version française d'excel et aussi pour
' se passer de la référence suivante :
' " Microsoft Visual Basic for Applications Extensibility 5.3"

Dim VBP As Object, oWin As Object
Dim wbActive As Workbook
Dim i As Integer

Set VBP = WB.VBProject
Set wbActive = ActiveWorkbook

If VBP.Protection <> 1 Then Exit Sub

Application.ScreenUpdating = False

' Close any code windows To ensure we hit the right project
For Each oWin In VBP.VBE.Windows
If InStr(oWin.Caption, "(") > 0 Then oWin.Close
Next oWin

WB.Activate
' now use lovely SendKeys To unprotect
Application.OnKey "%{F11}"
SendKeys "%{F11}%Oe" & Password & "~~%{F11}", True

If VBP.Protection = vbext_pp_locked Then
' failed - maybe wrong password
SendKeys "%{F11}%Oe", True
End If

' leave no evidence of the password
Password = ""
' go back To the previously active workbook
wbActive.Activate

End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Sub Détruire_Le_Code(Wk As Workbook)
Set VBComps = Wk.VBProject.VBComponents
For Each VBComp In VBComps
Select Case VBComp.Type
Case 100
With VBComp.CodeModule
.DeleteLines 1, .CountOfLines
End With
Case Else
VBComps.Remove VBComp
End Select
Next
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
François
Le #4751711
Bonjour Michdenis,

Merci beaucoup pour ta réponse très complète.
Je dois partir au travail et ne peut la tester maintenant.

Dès que je l'aurais tester, je te répondrai sur le forum.

Merci beaucoup

François


"MichDenis"
J'ai omis de modifier cette ligne de code dans la
procédure de Bill Manville :

| If VBP.Protection = vbext_pp_locked Then

Tu la remplaces par ceci :

If VBP.Protection = 1 Then




"MichDenis"
Dans la procédure originale de Bill Manville, il utilise ceci :
SendKeys "%{F11}%TE" & Password & "~~%{F11}", True

Mais comme Bill travaille sur une version anglaise, il faut traduire
les lettre TE pour Oe et la ligne de commande devient celle-ci :

SendKeys "%{F11}%Oe" & Password & "~~%{F11}", True

IMPORTANT : N'oublie pas de saisir le nom du fichier dont tu
veux déprotéger ton fichier dans la procédure "Test"

La procédure test doit être lancé à partir de l'interface de la
feuille de calcul et non à partir de la fenêtre de l'éditeur de code.

Cela devrait fonctionner pour les versions Excel 97 à Excel 2003.
Aucune idée pour la version 2007.

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub test()
Dim Wk As Workbook
'Ouvre le projet VBA
Set Wk = Workbooks("à détruire1.xls")

'Supprime toutes les procédures
UnprotectVBProject Wk, "denismichon"
Détruire_Le_Code Wk
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Sub UnprotectVBProject(WB As Workbook, ByVal Password As String)
'
' Bill Manville, 29-Jan-2000
' Que j'ai légèrement adapté en outre pour
' la version française d'excel et aussi pour
' se passer de la référence suivante :
' " Microsoft Visual Basic for Applications Extensibility 5.3"

Dim VBP As Object, oWin As Object
Dim wbActive As Workbook
Dim i As Integer

Set VBP = WB.VBProject
Set wbActive = ActiveWorkbook

If VBP.Protection <> 1 Then Exit Sub

Application.ScreenUpdating = False

' Close any code windows To ensure we hit the right project
For Each oWin In VBP.VBE.Windows
If InStr(oWin.Caption, "(") > 0 Then oWin.Close
Next oWin

WB.Activate
' now use lovely SendKeys To unprotect
Application.OnKey "%{F11}"
SendKeys "%{F11}%Oe" & Password & "~~%{F11}", True

If VBP.Protection = vbext_pp_locked Then
' failed - maybe wrong password
SendKeys "%{F11}%Oe", True
End If

' leave no evidence of the password
Password = ""
' go back To the previously active workbook
wbActive.Activate

End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Sub Détruire_Le_Code(Wk As Workbook)
Set VBComps = Wk.VBProject.VBComponents
For Each VBComp In VBComps
Select Case VBComp.Type
Case 100
With VBComp.CodeModule
.DeleteLines 1, .CountOfLines
End With
Case Else
VBComps.Remove VBComp
End Select
Next
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''





François
Le #4750391
Bonsoir Michdenis (ou plutôt Bonjour !)

J'ai mis le code dans mon fichier, et la macro bogue sur l'instruction :
Set Wk = Workbooks("Old " & annee & " " & base & ".xls")
dans la partie :
Dim Wk As Workbook 'open VBA project
Set Wk = Workbooks("Old " & annee & " " & base & ".xls")
UnprotectVBProject Wk, "bosquet"
Détruire_Le_Code Wk ' delete all the code
le débogueur m'annonce "indice en dehors de la plage " Erreur 9
et pourtant le fichier Old 2008 Mission Leave Plans (32) a bien été créé ...

Pour plus de facilité, je joins le fichier en Cjoint :
http://cjoint.com/?jkxS474V0g
mot de passe du fichier : rouen
mot de passe du VBA : bosquet

Merci beaucoup pour ton aide

François


"MichDenis"
J'ai omis de modifier cette ligne de code dans la
procédure de Bill Manville :

| If VBP.Protection = vbext_pp_locked Then

Tu la remplaces par ceci :

If VBP.Protection = 1 Then




"MichDenis"
Dans la procédure originale de Bill Manville, il utilise ceci :
SendKeys "%{F11}%TE" & Password & "~~%{F11}", True

Mais comme Bill travaille sur une version anglaise, il faut traduire
les lettre TE pour Oe et la ligne de commande devient celle-ci :

SendKeys "%{F11}%Oe" & Password & "~~%{F11}", True

IMPORTANT : N'oublie pas de saisir le nom du fichier dont tu
veux déprotéger ton fichier dans la procédure "Test"

La procédure test doit être lancé à partir de l'interface de la
feuille de calcul et non à partir de la fenêtre de l'éditeur de code.

Cela devrait fonctionner pour les versions Excel 97 à Excel 2003.
Aucune idée pour la version 2007.

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub test()
Dim Wk As Workbook
'Ouvre le projet VBA
Set Wk = Workbooks("à détruire1.xls")

'Supprime toutes les procédures
UnprotectVBProject Wk, "denismichon"
Détruire_Le_Code Wk
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Sub UnprotectVBProject(WB As Workbook, ByVal Password As String)
'
' Bill Manville, 29-Jan-2000
' Que j'ai légèrement adapté en outre pour
' la version française d'excel et aussi pour
' se passer de la référence suivante :
' " Microsoft Visual Basic for Applications Extensibility 5.3"

Dim VBP As Object, oWin As Object
Dim wbActive As Workbook
Dim i As Integer

Set VBP = WB.VBProject
Set wbActive = ActiveWorkbook

If VBP.Protection <> 1 Then Exit Sub

Application.ScreenUpdating = False

' Close any code windows To ensure we hit the right project
For Each oWin In VBP.VBE.Windows
If InStr(oWin.Caption, "(") > 0 Then oWin.Close
Next oWin

WB.Activate
' now use lovely SendKeys To unprotect
Application.OnKey "%{F11}"
SendKeys "%{F11}%Oe" & Password & "~~%{F11}", True

If VBP.Protection = vbext_pp_locked Then
' failed - maybe wrong password
SendKeys "%{F11}%Oe", True
End If

' leave no evidence of the password
Password = ""
' go back To the previously active workbook
wbActive.Activate

End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Sub Détruire_Le_Code(Wk As Workbook)
Set VBComps = Wk.VBProject.VBComponents
For Each VBComp In VBComps
Select Case VBComp.Type
Case 100
With VBComp.CodeModule
.DeleteLines 1, .CountOfLines
End With
Case Else
VBComps.Remove VBComp
End Select
Next
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''





François
Le #4750371
Le même fichier, mais avec "Option Compare Text"
et une input box au début de programme archiver pour éviter tout problème de
lecture seule (même mot de passe que pour ouvrir le fichier : rouen)

http://cjoint.com/?jlaaLAMb2g

François

"MichDenis"
J'ai omis de modifier cette ligne de code dans la
procédure de Bill Manville :

| If VBP.Protection = vbext_pp_locked Then

Tu la remplaces par ceci :

If VBP.Protection = 1 Then




"MichDenis"
Dans la procédure originale de Bill Manville, il utilise ceci :
SendKeys "%{F11}%TE" & Password & "~~%{F11}", True

Mais comme Bill travaille sur une version anglaise, il faut traduire
les lettre TE pour Oe et la ligne de commande devient celle-ci :

SendKeys "%{F11}%Oe" & Password & "~~%{F11}", True

IMPORTANT : N'oublie pas de saisir le nom du fichier dont tu
veux déprotéger ton fichier dans la procédure "Test"

La procédure test doit être lancé à partir de l'interface de la
feuille de calcul et non à partir de la fenêtre de l'éditeur de code.

Cela devrait fonctionner pour les versions Excel 97 à Excel 2003.
Aucune idée pour la version 2007.

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub test()
Dim Wk As Workbook
'Ouvre le projet VBA
Set Wk = Workbooks("à détruire1.xls")

'Supprime toutes les procédures
UnprotectVBProject Wk, "denismichon"
Détruire_Le_Code Wk
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Sub UnprotectVBProject(WB As Workbook, ByVal Password As String)
'
' Bill Manville, 29-Jan-2000
' Que j'ai légèrement adapté en outre pour
' la version française d'excel et aussi pour
' se passer de la référence suivante :
' " Microsoft Visual Basic for Applications Extensibility 5.3"

Dim VBP As Object, oWin As Object
Dim wbActive As Workbook
Dim i As Integer

Set VBP = WB.VBProject
Set wbActive = ActiveWorkbook

If VBP.Protection <> 1 Then Exit Sub

Application.ScreenUpdating = False

' Close any code windows To ensure we hit the right project
For Each oWin In VBP.VBE.Windows
If InStr(oWin.Caption, "(") > 0 Then oWin.Close
Next oWin

WB.Activate
' now use lovely SendKeys To unprotect
Application.OnKey "%{F11}"
SendKeys "%{F11}%Oe" & Password & "~~%{F11}", True

If VBP.Protection = vbext_pp_locked Then
' failed - maybe wrong password
SendKeys "%{F11}%Oe", True
End If

' leave no evidence of the password
Password = ""
' go back To the previously active workbook
wbActive.Activate

End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Sub Détruire_Le_Code(Wk As Workbook)
Set VBComps = Wk.VBProject.VBComponents
For Each VBComp In VBComps
Select Case VBComp.Type
Case 100
With VBComp.CodeModule
.DeleteLines 1, .CountOfLines
End With
Case Else
VBComps.Remove VBComp
End Select
Next
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''





MichDenis
Le #4750341
Désolé, je n'ai pas ouvert ton fichier. Personnellement
je n'offre pas un service de "déboguage".

La proposition faite à ta demande initiale à savoir
comment "déprotéger le code d'un classeur et supprimer
toutes les procédures du fichier est complète et opérationnelle.

L'adaptation de cette procédure à ta réalité,
c'est ton boulot et non le mien.

| le débogueur m'annonce "indice en dehors de la plage " Erreur 9
*** Cette erreur survient lorsque l'objet identifié n'existe pas
ou mal orthographié....

2 exemples :

A )
Si dans une procédure, tu as cette ligne de code et que tu n'as aucune
feuille ayant un onglet au nom de "Feuil4" dans ton classeur,
cela provoquera une "Erreur 9"

Set sh = Worksheets("Feuil4")

B )
Même principe dans le cas d'un classeur
Set Wk = Workbooks("Classeur3.xls")

Suggestion :

Dans ta procédure, tu aurais tout avantage à utiliser une variable pour
contenir le nom de ton fichier

Dim MonFichier As String
MonFichier = "Old " & annee & " " & base & ".xls"
Set Wk = Workbooks(MonFichier)

Si tu répètes à divers endroit le nom du fichier, le risque d'erreur
est de beaucoup réduit et tu te facilites la tâche lors du déboguage
car tu auras à vérifier qu'à un seul endroit le nom de ton fichier est exact.









"François" uq9QcQ$
Bonsoir Michdenis (ou plutôt Bonjour !)

J'ai mis le code dans mon fichier, et la macro bogue sur l'instruction :
Set Wk = Workbooks("Old " & annee & " " & base & ".xls")
dans la partie :
Dim Wk As Workbook 'open VBA project
Set Wk = Workbooks("Old " & annee & " " & base & ".xls")
UnprotectVBProject Wk, "bosquet"
Détruire_Le_Code Wk ' delete all the code
le débogueur m'annonce "indice en dehors de la plage " Erreur 9
et pourtant le fichier Old 2008 Mission Leave Plans (32) a bien été créé ...

Pour plus de facilité, je joins le fichier en Cjoint :
http://cjoint.com/?jkxS474V0g
mot de passe du fichier : rouen
mot de passe du VBA : bosquet

Merci beaucoup pour ton aide

François


"MichDenis"
J'ai omis de modifier cette ligne de code dans la
procédure de Bill Manville :

| If VBP.Protection = vbext_pp_locked Then

Tu la remplaces par ceci :

If VBP.Protection = 1 Then




"MichDenis"
Dans la procédure originale de Bill Manville, il utilise ceci :
SendKeys "%{F11}%TE" & Password & "~~%{F11}", True

Mais comme Bill travaille sur une version anglaise, il faut traduire
les lettre TE pour Oe et la ligne de commande devient celle-ci :

SendKeys "%{F11}%Oe" & Password & "~~%{F11}", True

IMPORTANT : N'oublie pas de saisir le nom du fichier dont tu
veux déprotéger ton fichier dans la procédure "Test"

La procédure test doit être lancé à partir de l'interface de la
feuille de calcul et non à partir de la fenêtre de l'éditeur de code.

Cela devrait fonctionner pour les versions Excel 97 à Excel 2003.
Aucune idée pour la version 2007.

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub test()
Dim Wk As Workbook
'Ouvre le projet VBA
Set Wk = Workbooks("à détruire1.xls")

'Supprime toutes les procédures
UnprotectVBProject Wk, "denismichon"
Détruire_Le_Code Wk
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Sub UnprotectVBProject(WB As Workbook, ByVal Password As String)
'
' Bill Manville, 29-Jan-2000
' Que j'ai légèrement adapté en outre pour
' la version française d'excel et aussi pour
' se passer de la référence suivante :
' " Microsoft Visual Basic for Applications Extensibility 5.3"

Dim VBP As Object, oWin As Object
Dim wbActive As Workbook
Dim i As Integer

Set VBP = WB.VBProject
Set wbActive = ActiveWorkbook

If VBP.Protection <> 1 Then Exit Sub

Application.ScreenUpdating = False

' Close any code windows To ensure we hit the right project
For Each oWin In VBP.VBE.Windows
If InStr(oWin.Caption, "(") > 0 Then oWin.Close
Next oWin

WB.Activate
' now use lovely SendKeys To unprotect
Application.OnKey "%{F11}"
SendKeys "%{F11}%Oe" & Password & "~~%{F11}", True

If VBP.Protection = vbext_pp_locked Then
' failed - maybe wrong password
SendKeys "%{F11}%Oe", True
End If

' leave no evidence of the password
Password = ""
' go back To the previously active workbook
wbActive.Activate

End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Sub Détruire_Le_Code(Wk As Workbook)
Set VBComps = Wk.VBProject.VBComponents
For Each VBComp In VBComps
Select Case VBComp.Type
Case 100
With VBComp.CodeModule
.DeleteLines 1, .CountOfLines
End With
Case Else
VBComps.Remove VBComp
End Select
Next
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''





François
Le #4750331
"MichDenis" %
Désolé, je n'ai pas ouvert ton fichier. Personnellement
je n'offre pas un service de "déboguage".

La proposition faite à ta demande initiale à savoir
comment "déprotéger le code d'un classeur et supprimer
toutes les procédures du fichier est complète et opérationnelle.

L'adaptation de cette procédure à ta réalité,
c'est ton boulot et non le mien.

| le débogueur m'annonce "indice en dehors de la plage " Erreur 9
*** Cette erreur survient lorsque l'objet identifié n'existe pas
ou mal orthographié....

2 exemples :

A )
Si dans une procédure, tu as cette ligne de code et que tu n'as aucune
feuille ayant un onglet au nom de "Feuil4" dans ton classeur,
cela provoquera une "Erreur 9"

Set sh = Worksheets("Feuil4")

B )
Même principe dans le cas d'un classeur
Set Wk = Workbooks("Classeur3.xls")

Suggestion :

Dans ta procédure, tu aurais tout avantage à utiliser une variable pour
contenir le nom de ton fichier

Dim MonFichier As String
MonFichier = "Old " & annee & " " & base & ".xls"
Set Wk = Workbooks(MonFichier)

Si tu répètes à divers endroit le nom du fichier, le risque d'erreur
est de beaucoup réduit et tu te facilites la tâche lors du déboguage
car tu auras à vérifier qu'à un seul endroit le nom de ton fichier est
exact.









"François" uq9QcQ$
Bonsoir Michdenis (ou plutôt Bonjour !)

J'ai mis le code dans mon fichier, et la macro bogue sur l'instruction :
Set Wk = Workbooks("Old " & annee & " " & base & ".xls")
dans la partie :
Dim Wk As Workbook 'open VBA project
Set Wk = Workbooks("Old " & annee & " " & base & ".xls")
UnprotectVBProject Wk, "bosquet"
Détruire_Le_Code Wk ' delete all the code
le débogueur m'annonce "indice en dehors de la plage " Erreur 9
et pourtant le fichier Old 2008 Mission Leave Plans (32) a bien été créé
...

Pour plus de facilité, je joins le fichier en Cjoint :
http://cjoint.com/?jkxS474V0g
mot de passe du fichier : rouen
mot de passe du VBA : bosquet

Merci beaucoup pour ton aide

François


"MichDenis"
J'ai omis de modifier cette ligne de code dans la
procédure de Bill Manville :

| If VBP.Protection = vbext_pp_locked Then

Tu la remplaces par ceci :

If VBP.Protection = 1 Then




"MichDenis"
Dans la procédure originale de Bill Manville, il utilise ceci :
SendKeys "%{F11}%TE" & Password & "~~%{F11}", True

Mais comme Bill travaille sur une version anglaise, il faut traduire
les lettre TE pour Oe et la ligne de commande devient celle-ci :

SendKeys "%{F11}%Oe" & Password & "~~%{F11}", True

IMPORTANT : N'oublie pas de saisir le nom du fichier dont tu
veux déprotéger ton fichier dans la procédure "Test"

La procédure test doit être lancé à partir de l'interface de la
feuille de calcul et non à partir de la fenêtre de l'éditeur de code.

Cela devrait fonctionner pour les versions Excel 97 à Excel 2003.
Aucune idée pour la version 2007.

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub test()
Dim Wk As Workbook
'Ouvre le projet VBA
Set Wk = Workbooks("à détruire1.xls")

'Supprime toutes les procédures
UnprotectVBProject Wk, "denismichon"
Détruire_Le_Code Wk
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Sub UnprotectVBProject(WB As Workbook, ByVal Password As String)
'
' Bill Manville, 29-Jan-2000
' Que j'ai légèrement adapté en outre pour
' la version française d'excel et aussi pour
' se passer de la référence suivante :
' " Microsoft Visual Basic for Applications Extensibility 5.3"

Dim VBP As Object, oWin As Object
Dim wbActive As Workbook
Dim i As Integer

Set VBP = WB.VBProject
Set wbActive = ActiveWorkbook

If VBP.Protection <> 1 Then Exit Sub

Application.ScreenUpdating = False

' Close any code windows To ensure we hit the right project
For Each oWin In VBP.VBE.Windows
If InStr(oWin.Caption, "(") > 0 Then oWin.Close
Next oWin

WB.Activate
' now use lovely SendKeys To unprotect
Application.OnKey "%{F11}"
SendKeys "%{F11}%Oe" & Password & "~~%{F11}", True

If VBP.Protection = vbext_pp_locked Then
' failed - maybe wrong password
SendKeys "%{F11}%Oe", True
End If

' leave no evidence of the password
Password = ""
' go back To the previously active workbook
wbActive.Activate

End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Sub Détruire_Le_Code(Wk As Workbook)
Set VBComps = Wk.VBProject.VBComponents
For Each VBComp In VBComps
Select Case VBComp.Type
Case 100
With VBComp.CodeModule
.DeleteLines 1, .CountOfLines
End With
Case Else
VBComps.Remove VBComp
End Select
Next
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''










François
Le #4750321
Bonsoir Michdenis,

Je te remercie beaucoup pour toute l'aide que tu m'as déjà apportée pour ces
problèmes.
Je vais essayer de l'exploiter au mieux.

Bonne journée

François

"MichDenis" %
Désolé, je n'ai pas ouvert ton fichier. Personnellement
je n'offre pas un service de "déboguage".

La proposition faite à ta demande initiale à savoir
comment "déprotéger le code d'un classeur et supprimer
toutes les procédures du fichier est complète et opérationnelle.

L'adaptation de cette procédure à ta réalité,
c'est ton boulot et non le mien.

| le débogueur m'annonce "indice en dehors de la plage " Erreur 9
*** Cette erreur survient lorsque l'objet identifié n'existe pas
ou mal orthographié....

2 exemples :

A )
Si dans une procédure, tu as cette ligne de code et que tu n'as aucune
feuille ayant un onglet au nom de "Feuil4" dans ton classeur,
cela provoquera une "Erreur 9"

Set sh = Worksheets("Feuil4")

B )
Même principe dans le cas d'un classeur
Set Wk = Workbooks("Classeur3.xls")

Suggestion :

Dans ta procédure, tu aurais tout avantage à utiliser une variable pour
contenir le nom de ton fichier

Dim MonFichier As String
MonFichier = "Old " & annee & " " & base & ".xls"
Set Wk = Workbooks(MonFichier)

Si tu répètes à divers endroit le nom du fichier, le risque d'erreur
est de beaucoup réduit et tu te facilites la tâche lors du déboguage
car tu auras à vérifier qu'à un seul endroit le nom de ton fichier est
exact.









"François" uq9QcQ$
Bonsoir Michdenis (ou plutôt Bonjour !)

J'ai mis le code dans mon fichier, et la macro bogue sur l'instruction :
Set Wk = Workbooks("Old " & annee & " " & base & ".xls")
dans la partie :
Dim Wk As Workbook 'open VBA project
Set Wk = Workbooks("Old " & annee & " " & base & ".xls")
UnprotectVBProject Wk, "bosquet"
Détruire_Le_Code Wk ' delete all the code
le débogueur m'annonce "indice en dehors de la plage " Erreur 9
et pourtant le fichier Old 2008 Mission Leave Plans (32) a bien été créé
...

Pour plus de facilité, je joins le fichier en Cjoint :
http://cjoint.com/?jkxS474V0g
mot de passe du fichier : rouen
mot de passe du VBA : bosquet

Merci beaucoup pour ton aide

François


"MichDenis"
J'ai omis de modifier cette ligne de code dans la
procédure de Bill Manville :

| If VBP.Protection = vbext_pp_locked Then

Tu la remplaces par ceci :

If VBP.Protection = 1 Then




"MichDenis"
Dans la procédure originale de Bill Manville, il utilise ceci :
SendKeys "%{F11}%TE" & Password & "~~%{F11}", True

Mais comme Bill travaille sur une version anglaise, il faut traduire
les lettre TE pour Oe et la ligne de commande devient celle-ci :

SendKeys "%{F11}%Oe" & Password & "~~%{F11}", True

IMPORTANT : N'oublie pas de saisir le nom du fichier dont tu
veux déprotéger ton fichier dans la procédure "Test"

La procédure test doit être lancé à partir de l'interface de la
feuille de calcul et non à partir de la fenêtre de l'éditeur de code.

Cela devrait fonctionner pour les versions Excel 97 à Excel 2003.
Aucune idée pour la version 2007.

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub test()
Dim Wk As Workbook
'Ouvre le projet VBA
Set Wk = Workbooks("à détruire1.xls")

'Supprime toutes les procédures
UnprotectVBProject Wk, "denismichon"
Détruire_Le_Code Wk
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Sub UnprotectVBProject(WB As Workbook, ByVal Password As String)
'
' Bill Manville, 29-Jan-2000
' Que j'ai légèrement adapté en outre pour
' la version française d'excel et aussi pour
' se passer de la référence suivante :
' " Microsoft Visual Basic for Applications Extensibility 5.3"

Dim VBP As Object, oWin As Object
Dim wbActive As Workbook
Dim i As Integer

Set VBP = WB.VBProject
Set wbActive = ActiveWorkbook

If VBP.Protection <> 1 Then Exit Sub

Application.ScreenUpdating = False

' Close any code windows To ensure we hit the right project
For Each oWin In VBP.VBE.Windows
If InStr(oWin.Caption, "(") > 0 Then oWin.Close
Next oWin

WB.Activate
' now use lovely SendKeys To unprotect
Application.OnKey "%{F11}"
SendKeys "%{F11}%Oe" & Password & "~~%{F11}", True

If VBP.Protection = vbext_pp_locked Then
' failed - maybe wrong password
SendKeys "%{F11}%Oe", True
End If

' leave no evidence of the password
Password = ""
' go back To the previously active workbook
wbActive.Activate

End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Sub Détruire_Le_Code(Wk As Workbook)
Set VBComps = Wk.VBProject.VBComponents
For Each VBComp In VBComps
Select Case VBComp.Type
Case 100
With VBComp.CodeModule
.DeleteLines 1, .CountOfLines
End With
Case Else
VBComps.Remove VBComp
End Select
Next
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''










Publicité
Poster une réponse
Anonyme