Déprotection de projet VBA par codes

SHINTRA

XLDnaute Occasionnel
Bonjour tout le monde.

Tout d'abord une bonne et heureuse année 2008 à tous.

Le problème qui m'amène aujourd'hui est le suivant :
je dispose d'une base de fichier Excel ( une 100 enivrions) que je consilde par macro.
Tous ces fichiers étant destiné à une utilisation externe j'ai protégé le classeur et les macros qu'elles contenaient. Le projet VBA est donc verrouillé par mot de passe.

je souhaiterais aujourd'hui supprimer le mot de passe pour l'accès au code VBA sur tous mes fichiers.

J'ai fait quelques recherches et je suis finalement arrivé au code suivant.

Malheureusement, il ne marche que pour le premier fichier de la liste et j'ai du mal a comprendre pourquoi.

Est-ce que quelqu'un pourrait m'aider.

D'avance merci


Code:
/

Option Explicit

Private Declare Function FindWindowA Lib "User32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetForegroundWindow Lib "User32" () As Long
Private Declare Function SetForegroundWindow Lib "User32" (ByVal hWnd As Long) As Long

Public classeur As String
Public i As Integer
Public Wb As Workbook
Public x As Workbook


Function Déprotège(classeur As String, MdP As String) As Boolean
Dim XLhWnd As Long, VBEhWnd As Long, CurhWnd As Long
Dim Wbk As Workbook
On Error Resume Next
Set Wbk = Workbooks(Dir$(classeur))
On Error GoTo Fin
  If Not Wbk Is Nothing Then
    If UCase$(Wbk.FullName) <> UCase$(classeur) Then Exit Function
    If Not Wbk.Saved Then Wbk.Save
  End If
  If Not ActiveWorkbook Is Wbk Then Set Wbk = ActiveWorkbook
  CurhWnd = GetForegroundWindow
  XLhWnd = FindWindowA("XLMAIN", Application.Caption)
  With Application.VBE
    VBEhWnd = FindWindowA("wndclass_desked_gsk", .MainWindow.Caption)
    If CurhWnd = XLhWnd Then SetForegroundWindow VBEhWnd
      .CommandBars.FindControl(ID:=2557).Execute
       If ActiveWorkbook.VBProject.Protection = 1 Then
      SendKeys "~" & MdP & "~", True
      .ActiveCodePane.Window.Close
    End If
  End With
  Wbk.Activate
  SetForegroundWindow CurhWnd
  Déprotège = True
  Exit Function
Fin:
End Function

Sub deprotection_systematique()

Set Wb = ThisWorkbook
With Application.FileSearch
.NewSearch
.LookIn = Wb.Path
.SearchSubFolders = True
.FileType = msoFileTypeExcelWorkbooks
.Execute

For i = 1 To .FoundFiles.Count
If .FoundFiles(i) <> Wb.FullName Then
Set x = Workbooks.Open(.FoundFiles(i), True, , , , , , , , , , , False)
classeur = x.FullName

Call Déprotège(classeur, "monmotdepasse")

x.Close SaveChanges:=True

End If

Next i
End With
End Sub

/[Code]
 
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
312 229
Messages
2 086 423
Membres
103 206
dernier inscrit
diambote